diff --git a/.gitignore b/.gitignore index cafb205f72..ca3a7df6c0 100644 --- a/.gitignore +++ b/.gitignore @@ -1,27 +1,3 @@ -# Ignore externals -ccs_config -chem_proc -cime -components -manage_externals.log -src/physics/ali_arms/ -src/physics/carma/base -src/physics/clubb -src/physics/cosp2/src -src/physics/silhs -src/chemistry/geoschem/geoschem_src -src/physics/pumas -src/physics/pumas-frozen -src/physics/rrtmgp/data -src/physics/rrtmgp/ext -src/dynamics/fv3/atmos_cubed_sphere -libraries/FMS -libraries/mct -libraries/parallelio -src/atmos_phys -src/dynamics/mpas/dycore -share -src/hemco # Ignore compiled python buildnmlc buildcppc diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000000..1c67c1539e --- /dev/null +++ b/.gitmodules @@ -0,0 +1,192 @@ +[submodule "chem_proc"] + path = chem_proc + url = https://github.com/ESCOMP/CHEM_PREPROCESSOR.git + fxrequired = AlwaysRequired + fxtag = chem_proc5_0_06 + fxDONOTUSEurl = https://github.com/ESCOMP/CHEM_PREPROCESSOR.git + +[submodule "carma"] + path = src/physics/carma/base + url = https://github.com/ESCOMP/CARMA_base.git + fxrequired = AlwaysRequired + fxtag = carma4_01 + fxDONOTUSEurl = https://github.com/ESCOMP/CARMA_base.git + +[submodule "pumas"] + path = src/physics/pumas + url = https://github.com/ESCOMP/PUMAS + fxrequired = AlwaysRequired + fxtag = pumas_cam-release_v1.36 + fxDONOTUSEurl = https://github.com/ESCOMP/PUMAS + +[submodule "pumas-frozen"] + path = src/physics/pumas-frozen + url = https://github.com/ESCOMP/PUMAS + fxrequired = AlwaysRequired + fxtag = pumas_cam-release_v1.17_rename + fxDONOTUSEurl = https://github.com/ESCOMP/PUMAS + +[submodule "ali_arms"] + path = src/physics/ali_arms + url = https://github.com/ESCOMP/ALI-ARMS + fxrequired = AlwaysRequired + fxtag = ALI_ARMS_v1.0.1 + fxDONOTUSEurl = https://github.com/ESCOMP/ALI-ARMS + +[submodule "atmos_phys"] + path = src/atmos_phys + url = https://github.com/ESCOMP/atmospheric_physics + fxtag = atmos_phys0_03_000 + fxrequired = AlwaysRequired + fxDONOTUSEurl = https://github.com/ESCOMP/atmospheric_physics + +[submodule "fv3"] + path = src/dynamics/fv3 + url = https://github.com/ESCOMP/CAM_FV3_interface.git + fxrequired = AlwaysRequired + fxtag = fv3int_061924 + fxDONOTUSEurl = https://github.com/ESCOMP/CAM_FV3_interface.git + +[submodule "geoschem"] + path = src/chemistry/geoschem/geoschem_src + url = https://github.com/geoschem/geos-chem.git + fxrequired = AlwaysRequired + fxtag = 14.1.2 + fxDONOTUSEurl = https://github.com/geoschem/geos-chem.git + +[submodule "hemco"] + path = src/hemco + url = https://github.com/ESCOMP/HEMCO_CESM.git + fxtag = hemco-cesm1_2_1_hemco3_6_3_cesm_rme01 + fxrequired = AlwaysRequired + fxDONOTUSEurl = https://github.com/ESCOMP/HEMCO_CESM.git + +[submodule "rte-rrtmgp"] + path = src/physics/rrtmgp/ext + url = https://github.com/earth-system-radiation/rte-rrtmgp.git + fxrequired = AlwaysRequired + fxtag = v1.7 + fxDONOTUSEurl = https://github.com/earth-system-radiation/rte-rrtmgp.git + +[submodule "rrtmgp-data"] + path = src/physics/rrtmgp/data + url = https://github.com/earth-system-radiation/rrtmgp-data.git + fxrequired = AlwaysRequired + fxtag = v1.8 + fxDONOTUSEurl = https://github.com/earth-system-radiation/rrtmgp-data.git + +[submodule "mpas"] + path = src/dynamics/mpas/dycore + url = https://github.com/EarthWorksOrg/MPAS-Model.git + fxrequired = AlwaysRequired + fxsparse = ../.mpas_sparse_checkout + fxtag = mpas-ew2.3.001 + fxDONOTUSEurl = https://github.com/MPAS-Dev/MPAS-Model.git + +[submodule "cosp2"] + path = src/physics/cosp2/src + url = https://github.com/CFMIP/COSPv2.0 + fxrequired = AlwaysRequired + fxsparse = ../.cosp_sparse_checkout + fxtag = v2.1.4cesm + fxDONOTUSEurl = https://github.com/CFMIP/COSPv2.0 + +[submodule "clubb"] + path = src/physics/clubb + url = https://github.com/larson-group/clubb_release + fxrequired = AlwaysRequired + fxsparse = ../.clubb_sparse_checkout + fxtag = clubb_4ncar_20240605_73d60f6_gpufixes_posinf + fxDONOTUSEurl = https://github.com/larson-group/clubb_release + +[submodule "cism"] +path = components/cism +url = https://github.com/ESCOMP/CISM-wrapper +fxtag = cismwrap_2_2_002 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESCOMP/CISM-wrapper + +[submodule "rtm"] +path = components/rtm +url = https://github.com/ESCOMP/RTM +fxtag = rtm1_0_80 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESCOMP/RTM + +[submodule "mosart"] +path = components/mosart +url = https://github.com/ESCOMP/MOSART +fxtag = mosart1.1.02 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESCOMP/MOSART + +[submodule "mizuRoute"] +path = components/mizuRoute +url = https://github.com/ESCOMP/mizuRoute +fxtag = cesm-coupling.n02_v2.1.3 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESCOMP/mizuRoute + +[submodule "ccs_config"] +path = ccs_config +url = https://github.com/ESMCI/ccs_config_cesm.git +fxtag = ccs_config_cesm1.0.0 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESMCI/ccs_config_cesm.git + +[submodule "cime"] +path = cime +url = https://github.com/ESMCI/cime +fxtag = cime6.1.0 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESMCI/cime + +[submodule "cmeps"] +path = components/cmeps +url = https://github.com/ESCOMP/CMEPS.git +fxtag = cmeps1.0.2 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESCOMP/CMEPS.git + +[submodule "cdeps"] +path = components/cdeps +url = https://github.com/ESCOMP/CDEPS.git +fxtag = cdeps1.0.45 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESCOMP/CDEPS.git + +[submodule "share"] +path = share +url = https://github.com/ESCOMP/CESM_share +fxtag = share1.1.2 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESCOMP/CESM_share + +[submodule "parallelio"] +path = libraries/parallelio +url = https://github.com/NCAR/ParallelIO +fxtag = pio2_6_2 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/NCAR/ParallelIO + +[submodule "cice"] +path = components/cice +url = https://github.com/ESCOMP/CESM_CICE +fxtag = cesm_cice6_5_0_10 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESCOMP/CESM_CICE + +[submodule "clm"] +path = components/clm +url = https://github.com/ESCOMP/CTSM +fxtag = ctsm5.2.009 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESCOMP/CTSM + +[submodule "fms"] +path = libraries/FMS +url = https://github.com/ESCOMP/FMS_interface +fxtag = fi_240516 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESCOMP/FMS_interface + diff --git a/.lib/git-fleximod/.github/workflows/pre-commit b/.lib/git-fleximod/.github/workflows/pre-commit new file mode 100644 index 0000000000..1a6ad0082a --- /dev/null +++ b/.lib/git-fleximod/.github/workflows/pre-commit @@ -0,0 +1,13 @@ +name: pre-commit +on: + pull_request: + push: + branches: [main] + +jobs: + pre-commit: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v3 + - uses: actions/setup-python@v3 + - uses: pre-commit/action@v3.0.0 diff --git a/.lib/git-fleximod/.github/workflows/pytest.yaml b/.lib/git-fleximod/.github/workflows/pytest.yaml new file mode 100644 index 0000000000..0868dd9a33 --- /dev/null +++ b/.lib/git-fleximod/.github/workflows/pytest.yaml @@ -0,0 +1,77 @@ +# Run this job on pushes to `main`, and for pull requests. If you don't specify +# `branches: [main], then this actions runs _twice_ on pull requests, which is +# annoying. + +on: + push: + branches: [main] + pull_request: + branches: [main] + +jobs: + test: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + + # If you wanted to use multiple Python versions, you'd have specify a matrix in the job and + # reference the matrixe python version here. + - uses: actions/setup-python@v5 + with: + python-version: '3.9' + + # Cache the installation of Poetry itself, e.g. the next step. This prevents the workflow + # from installing Poetry every time, which can be slow. Note the use of the Poetry version + # number in the cache key, and the "-0" suffix: this allows you to invalidate the cache + # manually if/when you want to upgrade Poetry, or if something goes wrong. This could be + # mildly cleaner by using an environment variable, but I don't really care. + - name: cache poetry install + uses: actions/cache@v4 + with: + path: ~/.local + key: poetry-1.7.1 + + # Install Poetry. You could do this manually, or there are several actions that do this. + # `snok/install-poetry` seems to be minimal yet complete, and really just calls out to + # Poetry's default install script, which feels correct. I pin the Poetry version here + # because Poetry does occasionally change APIs between versions and I don't want my + # actions to break if it does. + # + # The key configuration value here is `virtualenvs-in-project: true`: this creates the + # venv as a `.venv` in your testing directory, which allows the next step to easily + # cache it. + - uses: snok/install-poetry@v1 + with: + version: 1.7.1 + virtualenvs-create: true + virtualenvs-in-project: true + + # Cache your dependencies (i.e. all the stuff in your `pyproject.toml`). Note the cache + # key: if you're using multiple Python versions, or multiple OSes, you'd need to include + # them in the cache key. I'm not, so it can be simple and just depend on the poetry.lock. + - name: cache deps + id: cache-deps + uses: actions/cache@v4 + with: + path: .venv + key: pydeps-${{ hashFiles('**/poetry.lock') }} + + # Install dependencies. `--no-root` means "install all dependencies but not the project + # itself", which is what you want to avoid caching _your_ code. The `if` statement + # ensures this only runs on a cache miss. + - run: poetry install --no-interaction --no-root + if: steps.cache-deps.outputs.cache-hit != 'true' + + # Now install _your_ project. This isn't necessary for many types of projects -- particularly + # things like Django apps don't need this. But it's a good idea since it fully-exercises the + # pyproject.toml and makes that if you add things like console-scripts at some point that + # they'll be installed and working. + - run: poetry install --no-interaction + + # And finally run tests. I'm using pytest and all my pytest config is in my `pyproject.toml` + # so this line is super-simple. But it could be as complex as you need. + - run: | + git config --global user.name "${GITHUB_ACTOR}" + git config --global user.email "${GITHUB_ACTOR_ID}+${GITHUB_ACTOR}@users.noreply.github.com" + poetry run pytest + diff --git a/.lib/git-fleximod/.pre-commit-config.yaml b/.lib/git-fleximod/.pre-commit-config.yaml new file mode 100644 index 0000000000..2f6089da72 --- /dev/null +++ b/.lib/git-fleximod/.pre-commit-config.yaml @@ -0,0 +1,18 @@ +exclude: ^utils/.*$ + +repos: + - repo: https://github.com/pre-commit/pre-commit-hooks + rev: v4.0.1 + hooks: + - id: end-of-file-fixer + - id: trailing-whitespace + - repo: https://github.com/psf/black + rev: 22.3.0 + hooks: + - id: black + - repo: https://github.com/PyCQA/pylint + rev: v2.11.1 + hooks: + - id: pylint + args: + - --disable=I,C,R,logging-not-lazy,wildcard-import,unused-wildcard-import,fixme,broad-except,bare-except,eval-used,exec-used,global-statement,logging-format-interpolation,no-name-in-module,arguments-renamed,unspecified-encoding,protected-access,import-error,no-member diff --git a/.lib/git-fleximod/CODE_OF_CONDUCT.md b/.lib/git-fleximod/CODE_OF_CONDUCT.md new file mode 100644 index 0000000000..84f2925bba --- /dev/null +++ b/.lib/git-fleximod/CODE_OF_CONDUCT.md @@ -0,0 +1,107 @@ +# Contributor Code of Conduct +_The Contributor Code of Conduct is for participants in our software projects and community._ + +## Our Pledge +We, as contributors, creators, stewards, and maintainers (participants), of **git-fleximod** pledge to make participation in +our software, system or hardware project and community a safe, productive, welcoming and inclusive experience for everyone. +All participants are required to abide by this Code of Conduct. +This includes respectful treatment of everyone regardless of age, body size, disability, ethnicity, gender identity or expression, +level of experience, nationality, political affiliation, veteran status, pregnancy, genetic information, physical appearance, race, +religion, or sexual orientation, as well as any other characteristic protected under applicable US federal or state law. + +## Our Standards +Examples of behaviors that contribute to a positive environment include: + +* All participants are treated with respect and consideration, valuing a diversity of views and opinions +* Be considerate, respectful, and collaborative +* Communicate openly with respect for others, critiquing ideas rather than individuals and gracefully accepting criticism +* Acknowledging the contributions of others +* Avoid personal attacks directed toward other participants +* Be mindful of your surroundings and of your fellow participants +* Alert UCAR staff and suppliers/vendors if you notice a dangerous situation or someone in distress +* Respect the rules and policies of the project and venue + +Examples of unacceptable behavior include, but are not limited to: + +* Harassment, intimidation, or discrimination in any form +* Physical, verbal, or written abuse by anyone to anyone, including repeated use of pronouns other than those requested +* Unwelcome sexual attention or advances +* Personal attacks directed at other guests, members, participants, etc. +* Publishing others' private information, such as a physical or electronic address, without explicit permission +* Alarming, intimidating, threatening, or hostile comments or conduct +* Inappropriate use of nudity and/or sexual images +* Threatening or stalking anyone, including a participant +* Other conduct which could reasonably be considered inappropriate in a professional setting + +## Scope +This Code of Conduct applies to all spaces managed by the Project whether they be physical, online or face-to-face. +This includes project code, code repository, associated web pages, documentation, mailing lists, project websites and wiki pages, +issue tracker, meetings, telecons, events, project social media accounts, and any other forums created by the project team which the +community uses for communication. +In addition, violations of this Code of Conduct outside these spaces may affect a person's ability to participate within them. +Representation of a project may be further defined and clarified by project maintainers. + +## Community Responsibilities +Everyone in the community is empowered to respond to people who are showing unacceptable behavior. +They can talk to them privately or publicly. +Anyone requested to stop unacceptable behavior is expected to comply immediately. +If the behavior continues concerns may be brought to the project administrators or to any other party listed in the +[Reporting](#reporting) section below. + +## Project Administrator Responsibilities +Project administrators are responsible for clarifying the standards of acceptable behavior and are encouraged to model appropriate +behavior and provide support when people in the community point out inappropriate behavior. +Project administrator(s) are normally the ones that would be tasked to carry out the actions in the [Consequences](#consequences) +section below. + +Project administrators are also expected to keep this Code of Conduct updated with the main one housed at UCAR, as listed below in +the [Attribution](#attribution) section. + +## Reporting +Instances of unacceptable behavior can be brought to the attention of the project administrator(s) who may take any action as +outlined in the [Consequences](#consequences) section below. +However, making a report to a project administrator is not considered an 'official report' to UCAR. + +Instances of unacceptable behavior may also be reported directly to UCAR pursuant to [UCAR's Harassment Reporting and Complaint +Procedure](https://www2.fin.ucar.edu/procedures/hr/harassment-reporting-and-complaint-procedure), or anonymously through [UCAR's +EthicsPoint Hotline](https://www2.fin.ucar.edu/ethics/anonymous-reporting). + +Complaints received by UCAR will be handled pursuant to the procedures outlined in UCAR's Harassment Reporting and Complaint +Procedure. +Complaints to UCAR will be held as confidential as practicable under the circumstances, and retaliation against a person who +initiates a complaint or an inquiry about inappropriate behavior will not be tolerated. + +Any Contributor can use these reporting methods even if they are not directly affiliated with UCAR. +The Frequently Asked Questions (FAQ) page for reporting is [here](https://www2.fin.ucar.edu/procedures/hr/reporting-faqs). + +## Consequences +Upon receipt of a complaint, the project administrator(s) may take any action deemed necessary and appropriate under the +circumstances. +Such action can include things such as: removing, editing, or rejecting comments, commits, code, wiki edits, email, issues, and +other contributions that are not aligned to this Code of Conduct, or banning temporarily or permanently any contributor for other +behaviors that are deemed inappropriate, threatening, offensive, or harmful. +Project administrators also have the right to report violations to UCAR HR and/or UCAR's Office of Diversity, Equity and Inclusion +(ODEI), as well as a participant's home institution and/or law enforcement. +In the event an incident is reported to UCAR, UCAR will follow its Harassment Reporting and Complaint Procedure. + +## Process for Changes +All UCAR managed projects are required to adopt this Contributor Code of Conduct. +Adoption is assumed even if not expressly stated in the repository. +Projects should fill in sections where prompted with project-specific information, including, project name and adoption date. + +Projects that adopt this Code of Conduct need to stay up to date with UCAR's Contributor Code of Conduct, linked with a DOI in the +[Attribution](#attribution) section below. +Projects can make limited substantive changes to the Code of Conduct, however, the changes must be limited in scope and may not +contradict the UCAR Contributor Code of Conduct. + +## Attribution +This Code of Conduct was originally adapted from the [Contributor Covenant](http://contributor-covenant.org/version/1/4), version +1.4. +We then aligned it with the UCAR Participant Code of Conduct, which also borrows from the American Geophysical Union (AGU) Code of +Conduct. +The UCAR Participant Code of Conduct applies to both UCAR employees as well as participants in activities run by UCAR. +The original version of this for all software projects that have strong management from UCAR or UCAR staff is available on the UCAR +website at https://doi.org/10.5065/6w2c-a132. +The date that it was adopted by this project was **Feb/13/2018**. +When responding to complaints, UCAR HR and ODEI will do so based on the latest published version. +Therefore, any project-specific changes should follow the [Process for Changes](#process-for-changes) section above. diff --git a/.lib/git-fleximod/License b/.lib/git-fleximod/License new file mode 100644 index 0000000000..88bc22515e --- /dev/null +++ b/.lib/git-fleximod/License @@ -0,0 +1,20 @@ +Copyright 2024 NSF National Center for Atmospheric Sciences (NCAR) + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +“Software”), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/.lib/git-fleximod/README.md b/.lib/git-fleximod/README.md new file mode 100644 index 0000000000..53917da400 --- /dev/null +++ b/.lib/git-fleximod/README.md @@ -0,0 +1,108 @@ +# git-fleximod + +Flexible, Enhanced Submodule Management for Git + +## Overview + +Git-fleximod is a Python-based tool that extends Git's submodule and sparse checkout capabilities, offering additional features for managing submodules in a more flexible and efficient way. + +## Installation + + If you choose to locate git-fleximod in your path you can access it via command: git fleximod + +## Usage + + Basic Usage: + git fleximod [options] + Available Commands: + status: Display the status of submodules. + update: Update submodules to the tag indicated in .gitmodules variable fxtag. + test: Make sure that fxtags and submodule hashes are consistant, + make sure that official urls (as defined by fxDONOTUSEurl) are set + make sure that fxtags are defined for all submodules + Additional Options: + See git fleximod --help for more details. + +## Supported .gitmodules Variables + + fxtag: Specify a specific tag or branch to checkout for a submodule. + fxrequired: Mark a submodule's checkout behavior, with allowed values: + - ToplevelRequired: Top-level and required (checked out only when this is the Toplevel module). + - ToplevelOptional: Top-level and optional (checked out with --optional flag if this is the Toplevel module). + - AlwaysRequired: Always required (always checked out). + - AlwaysOptional: Always optional (checked out with --optional flag). + fxsparse: Enable sparse checkout for a submodule, pointing to a file containing sparse checkout paths. + fxDONOTUSEurl: This is the url used in the test subcommand to assure that protected branches do not point to forks + **NOTE** the fxDONOTUSEurl variable is only used to identify the official project repository and should not be + changed by users. Use the url variable to change to a fork if desired. + +## Sparse Checkouts + + To enable sparse checkout for a submodule, set the fxsparse variable + in the .gitmodules file to the path of a file containing the desired + sparse checkout paths. Git-fleximod will automatically configure + sparse checkout based on this file when applicable commands are run. + See [git-sparse-checkout](https://git-scm.com/docs/git-sparse-checkout#_internalsfull_pattern_set) + for details on the format of this file. + +## Tests + + The git fleximod test action is designed to be used by, for example, github workflows + to assure that protected branches are consistant with respect to submodule hashes and fleximod fxtags + +## Examples + +Here are some common usage examples: + +Update all submodules, including optional ones: +```bash + git fleximod update --optional +``` + +Updating a specific submodule to the fxtag indicated in .gitmodules: + +```bash + git fleximod update submodule-name +``` +Example .gitmodules entry: +```ini, toml + [submodule "cosp2"] + path = src/physics/cosp2/src + url = https://github.com/CFMIP/COSPv2.0 + fxsparse = ../.cosp_sparse_checkout + fxrequired = AlwaysRequired + fxtag = v2.1.4cesm +``` +Explanation: + +This entry indicates that the submodule named cosp2 at tag v2.1.4cesm +should be checked out into the directory src/physics/cosp2/src +relative to the .gitmodules directory. It should be checked out from +the URL https://github.com/CFMIP/COSPv2.0 and use sparse checkout as +described in the file ../.cosp_sparse_checkout relative to the path +directory. It should be checked out anytime this .gitmodules entry is +read. + +Additional example: +```ini, toml + [submodule "cime"] + path = cime + url = https://github.com/jedwards4b/cime + fxrequired = ToplevelRequired + fxtag = cime6.0.198_rme01 +``` + +Explanation: + +This entry indicates that the submodule cime should be checked out +into a directory named cime at tag cime6.0.198_rme01 from the URL +https://github.com/jedwards4b/cime. This should only be done if +the .gitmodules file is at the top level of the repository clone. + +## Contributing + +We welcome contributions! Please see the CONTRIBUTING.md file for guidelines. + +## License + +Git-fleximod is released under the MIT License. diff --git a/manage_externals/test/doc/Makefile b/.lib/git-fleximod/doc/Makefile similarity index 75% rename from manage_externals/test/doc/Makefile rename to .lib/git-fleximod/doc/Makefile index 18f4d5bf99..d4bb2cbb9e 100644 --- a/manage_externals/test/doc/Makefile +++ b/.lib/git-fleximod/doc/Makefile @@ -1,10 +1,10 @@ # Minimal makefile for Sphinx documentation # -# You can set these variables from the command line. -SPHINXOPTS = -SPHINXBUILD = sphinx-build -SPHINXPROJ = ManageExternals +# You can set these variables from the command line, and also +# from the environment for the first two. +SPHINXOPTS ?= +SPHINXBUILD ?= sphinx-build SOURCEDIR = . BUILDDIR = _build @@ -17,4 +17,4 @@ help: # Catch-all target: route all unknown targets to Sphinx using the new # "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS). %: Makefile - @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) \ No newline at end of file + @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) diff --git a/.lib/git-fleximod/doc/conf.py b/.lib/git-fleximod/doc/conf.py new file mode 100644 index 0000000000..423099eec9 --- /dev/null +++ b/.lib/git-fleximod/doc/conf.py @@ -0,0 +1,26 @@ +# Configuration file for the Sphinx documentation builder. +# +# For the full list of built-in configuration values, see the documentation: +# https://www.sphinx-doc.org/en/master/usage/configuration.html + +# -- Project information ----------------------------------------------------- +# https://www.sphinx-doc.org/en/master/usage/configuration.html#project-information + +project = "git-fleximod" +author = "Jim Edwards " +release = "0.4.0" + +# -- General configuration --------------------------------------------------- +# https://www.sphinx-doc.org/en/master/usage/configuration.html#general-configuration + +extensions = ["sphinx_argparse_cli"] + +templates_path = ["_templates"] +exclude_patterns = ["_build", "Thumbs.db", ".DS_Store"] + + +# -- Options for HTML output ------------------------------------------------- +# https://www.sphinx-doc.org/en/master/usage/configuration.html#options-for-html-output + +html_theme = "alabaster" +html_static_path = ["_static"] diff --git a/.lib/git-fleximod/doc/index.rst b/.lib/git-fleximod/doc/index.rst new file mode 100644 index 0000000000..0f9c1a7f7e --- /dev/null +++ b/.lib/git-fleximod/doc/index.rst @@ -0,0 +1,24 @@ +.. git-fleximod documentation master file, created by + sphinx-quickstart on Sat Feb 3 12:02:22 2024. + You can adapt this file completely to your liking, but it should at least + contain the root `toctree` directive. + +Welcome to git-fleximod's documentation! +======================================== + +.. toctree:: + :maxdepth: 2 + :caption: Contents: +.. module:: sphinxcontrib.autoprogram +.. sphinx_argparse_cli:: + :module: git_fleximod.cli + :func: get_parser + :prog: git-fleximod + + +Indices and tables +================== + +* :ref:`genindex` +* :ref:`modindex` +* :ref:`search` diff --git a/.lib/git-fleximod/doc/make.bat b/.lib/git-fleximod/doc/make.bat new file mode 100644 index 0000000000..32bb24529f --- /dev/null +++ b/.lib/git-fleximod/doc/make.bat @@ -0,0 +1,35 @@ +@ECHO OFF + +pushd %~dp0 + +REM Command file for Sphinx documentation + +if "%SPHINXBUILD%" == "" ( + set SPHINXBUILD=sphinx-build +) +set SOURCEDIR=. +set BUILDDIR=_build + +%SPHINXBUILD% >NUL 2>NUL +if errorlevel 9009 ( + echo. + echo.The 'sphinx-build' command was not found. Make sure you have Sphinx + echo.installed, then set the SPHINXBUILD environment variable to point + echo.to the full path of the 'sphinx-build' executable. Alternatively you + echo.may add the Sphinx directory to PATH. + echo. + echo.If you don't have Sphinx installed, grab it from + echo.https://www.sphinx-doc.org/ + exit /b 1 +) + +if "%1" == "" goto help + +%SPHINXBUILD% -M %1 %SOURCEDIR% %BUILDDIR% %SPHINXOPTS% %O% +goto end + +:help +%SPHINXBUILD% -M help %SOURCEDIR% %BUILDDIR% %SPHINXOPTS% %O% + +:end +popd diff --git a/.lib/git-fleximod/escomp_install b/.lib/git-fleximod/escomp_install new file mode 100644 index 0000000000..ae782e72a4 --- /dev/null +++ b/.lib/git-fleximod/escomp_install @@ -0,0 +1,25 @@ +#!/usr/bin/env python +# updates git-fleximod in an ESCOMP model +# this script should be run from the model root directory, it expects +# git-fleximod to already be installed with the script in bin +# and the classes in lib/python/site-packages +import sys +import shutil +import os + +from glob import iglob + +fleximod_root = sys.argv[1] +fleximod_path = os.path.join(fleximod_root,"src","git-fleximod") +if os.path.isfile(fleximod_path): + with open(fleximod_path,"r") as f: + fleximod = f.readlines() + with open(os.path.join(".","bin","git-fleximod"),"w") as f: + for line in fleximod: + f.write(line) + if "import argparse" in line: + f.write('\nsys.path.append(os.path.join(os.path.dirname(__file__),"..","lib","python","site-packages"))\n\n') + + for file in iglob(os.path.join(fleximod_root, "src", "fleximod", "*.py")): + shutil.copy(file, + os.path.join("lib","python","site-packages","fleximod",os.path.basename(file))) diff --git a/.lib/git-fleximod/git_fleximod/__init__.py b/.lib/git-fleximod/git_fleximod/__init__.py new file mode 100644 index 0000000000..e69de29bb2 diff --git a/.lib/git-fleximod/git_fleximod/cli.py b/.lib/git-fleximod/git_fleximod/cli.py new file mode 100644 index 0000000000..b6f728f881 --- /dev/null +++ b/.lib/git-fleximod/git_fleximod/cli.py @@ -0,0 +1,129 @@ +from pathlib import Path +import argparse +from git_fleximod import utils + +__version__ = "0.8.4" + +def find_root_dir(filename=".gitmodules"): + """ finds the highest directory in tree + which contains a file called filename """ + d = Path.cwd() + root = Path(d.root) + dirlist = [] + dl = d + while dl != root: + dirlist.append(dl) + dl = dl.parent + dirlist.append(root) + dirlist.reverse() + + for dl in dirlist: + attempt = dl / filename + if attempt.is_file(): + return str(dl) + return None + + +def get_parser(): + description = """ + %(prog)s manages checking out groups of gitsubmodules with additional support for Earth System Models + """ + parser = argparse.ArgumentParser( + description=description, formatter_class=argparse.RawDescriptionHelpFormatter + ) + + # + # user options + # + choices = ["update", "status", "test"] + parser.add_argument( + "action", + choices=choices, + default="update", + help=f"Subcommand of git-fleximod, choices are {choices[:-1]}", + ) + + parser.add_argument( + "components", + nargs="*", + help="Specific component(s) to checkout. By default, " + "all required submodules are checked out.", + ) + + parser.add_argument( + "-C", + "--path", + default=find_root_dir(), + help="Toplevel repository directory. Defaults to top git directory relative to current.", + ) + + parser.add_argument( + "-g", + "--gitmodules", + nargs="?", + default=".gitmodules", + help="The submodule description filename. " "Default: %(default)s.", + ) + + parser.add_argument( + "-x", + "--exclude", + nargs="*", + help="Component(s) listed in the gitmodules file which should be ignored.", + ) + parser.add_argument( + "-f", + "--force", + action="store_true", + default=False, + help="Override cautions and update or checkout over locally modified repository.", + ) + + parser.add_argument( + "-o", + "--optional", + action="store_true", + default=False, + help="By default only the required submodules " + "are checked out. This flag will also checkout the " + "optional submodules relative to the toplevel directory.", + ) + + parser.add_argument( + "-v", + "--verbose", + action="count", + default=0, + help="Output additional information to " + "the screen and log file. This flag can be " + "used up to two times, increasing the " + "verbosity level each time.", + ) + + parser.add_argument( + "-V", + "--version", + action="version", + version=f"%(prog)s {__version__}", + help="Print version and exit.", + ) + + # + # developer options + # + parser.add_argument( + "--backtrace", + action="store_true", + help="DEVELOPER: show exception backtraces as extra " "debugging output", + ) + + parser.add_argument( + "-d", + "--debug", + action="store_true", + default=False, + help="DEVELOPER: output additional debugging " + "information to the screen and log file.", + ) + + return parser diff --git a/.lib/git-fleximod/git_fleximod/git_fleximod.py b/.lib/git-fleximod/git_fleximod/git_fleximod.py new file mode 100755 index 0000000000..50e0ef83df --- /dev/null +++ b/.lib/git-fleximod/git_fleximod/git_fleximod.py @@ -0,0 +1,365 @@ +#!/usr/bin/env python +import sys + +MIN_PYTHON = (3, 7) +if sys.version_info < MIN_PYTHON: + sys.exit("Python %s.%s or later is required." % MIN_PYTHON) + +import os +import shutil +import logging +import textwrap +from git_fleximod import utils +from git_fleximod import cli +from git_fleximod.gitinterface import GitInterface +from git_fleximod.gitmodules import GitModules +from git_fleximod.submodule import Submodule + +# logger variable is global +logger = None + + +def fxrequired_allowed_values(): + return ["ToplevelRequired", "ToplevelOptional", "AlwaysRequired", "AlwaysOptional", "TopLevelRequired", "TopLevelOptional"] + + +def commandline_arguments(args=None): + parser = cli.get_parser() + + if args: + options = parser.parse_args(args) + else: + options = parser.parse_args() + + # explicitly listing a component overrides the optional flag + if options.optional or options.components: + fxrequired = fxrequired_allowed_values() + else: + fxrequired = ["ToplevelRequired", "AlwaysRequired", "TopLevelRequired"] + + action = options.action + if not action: + action = "update" + handlers = [logging.StreamHandler()] + + if options.debug: + try: + open("fleximod.log", "w") + except PermissionError: + sys.exit("ABORT: Could not write file fleximod.log") + level = logging.DEBUG + handlers.append(logging.FileHandler("fleximod.log")) + elif options.verbose: + level = logging.INFO + else: + level = logging.WARNING + # Configure the root logger + logging.basicConfig( + level=level, format="%(name)s - %(levelname)s - %(message)s", handlers=handlers + ) + + if hasattr(options, "version"): + exit() + + return ( + options.path, + options.gitmodules, + fxrequired, + options.components, + options.exclude, + options.force, + action, + ) + + +def submodule_sparse_checkout(root_dir, name, url, path, sparsefile, tag="master"): + """ + This function performs a sparse checkout of a git submodule. It does so by first creating the .git/info/sparse-checkout fileq + in the submodule and then checking out the desired tag. If the submodule is already checked out, it will not be checked out again. + Creating the sparse-checkout file first prevents the entire submodule from being checked out and then removed. This is important + because the submodule may have a large number of files and checking out the entire submodule and then removing it would be time + and disk space consuming. + + Parameters: + root_dir (str): The root directory for the git operation. + name (str): The name of the submodule. + url (str): The URL of the submodule. + path (str): The path to the submodule. + sparsefile (str): The sparse file for the submodule. + tag (str, optional): The tag to checkout. Defaults to "master". + + Returns: + None + """ + logger.info("Called sparse_checkout for {}".format(name)) + rgit = GitInterface(root_dir, logger) + superroot = git_toplevelroot(root_dir, logger) + + if superroot: + gitroot = superroot.strip() + else: + gitroot = root_dir.strip() + assert os.path.isdir(os.path.join(gitroot, ".git")) + # first create the module directory + if not os.path.isdir(os.path.join(root_dir, path)): + os.makedirs(os.path.join(root_dir, path)) + + # initialize a new git repo and set the sparse checkout flag + sprep_repo = os.path.join(root_dir, path) + sprepo_git = GitInterface(sprep_repo, logger) + if os.path.exists(os.path.join(sprep_repo, ".git")): + try: + logger.info("Submodule {} found".format(name)) + chk = sprepo_git.config_get_value("core", "sparseCheckout") + if chk == "true": + logger.info("Sparse submodule {} already checked out".format(name)) + return + except NoOptionError: + logger.debug("Sparse submodule {} not present".format(name)) + except Exception as e: + utils.fatal_error("Unexpected error {} occured.".format(e)) + + sprepo_git.config_set_value("core", "sparseCheckout", "true") + + # set the repository remote + + logger.info("Setting remote origin in {}/{}".format(root_dir, path)) + status = sprepo_git.git_operation("remote", "-v") + if url not in status: + sprepo_git.git_operation("remote", "add", "origin", url) + + topgit = os.path.join(gitroot, ".git") + + if gitroot != root_dir and os.path.isfile(os.path.join(root_dir, ".git")): + with open(os.path.join(root_dir, ".git")) as f: + gitpath = os.path.relpath( + os.path.join(root_dir, f.read().split()[1]), + start=os.path.join(root_dir, path), + ) + topgit = os.path.join(gitpath, "modules") + else: + topgit = os.path.relpath( + os.path.join(root_dir, ".git", "modules"), + start=os.path.join(root_dir, path), + ) + + with utils.pushd(sprep_repo): + if not os.path.isdir(topgit): + os.makedirs(topgit) + topgit += os.sep + name + + if os.path.isdir(os.path.join(root_dir, path, ".git")): + with utils.pushd(sprep_repo): + if os.path.isdir(os.path.join(topgit,".git")): + shutil.rmtree(os.path.join(topgit,".git")) + shutil.move(".git", topgit) + with open(".git", "w") as f: + f.write("gitdir: " + os.path.relpath(topgit)) + # assert(os.path.isdir(os.path.relpath(topgit, start=sprep_repo))) + gitsparse = os.path.abspath(os.path.join(topgit, "info", "sparse-checkout")) + if os.path.isfile(gitsparse): + logger.warning( + "submodule {} is already initialized {}".format(name, topgit) + ) + return + + with utils.pushd(sprep_repo): + if os.path.isfile(sparsefile): + shutil.copy(sparsefile, gitsparse) + + + # Finally checkout the repo + sprepo_git.git_operation("fetch", "origin", "--tags") + sprepo_git.git_operation("checkout", tag) + + print(f"Successfully checked out {name:>20} at {tag}") + rgit.config_set_value(f'submodule "{name}"', "active", "true") + rgit.config_set_value(f'submodule "{name}"', "url", url) + +def init_submodule_from_gitmodules(gitmodules, name, root_dir, logger): + path = gitmodules.get(name, "path") + url = gitmodules.get(name, "url") + assert path and url, f"Malformed .gitmodules file {path} {url}" + tag = gitmodules.get(name, "fxtag") + fxurl = gitmodules.get(name, "fxDONOTUSEurl") + fxsparse = gitmodules.get(name, "fxsparse") + fxrequired = gitmodules.get(name, "fxrequired") + return Submodule(root_dir, name, path, url, fxtag=tag, fxurl=fxurl, fxsparse=fxsparse, fxrequired=fxrequired, logger=logger) + +def submodules_status(gitmodules, root_dir, toplevel=False, depth=0): + testfails = 0 + localmods = 0 + needsupdate = 0 + wrapper = textwrap.TextWrapper(initial_indent=' '*(depth*10), width=120,subsequent_indent=' '*(depth*20)) + for name in gitmodules.sections(): + submod = init_submodule_from_gitmodules(gitmodules, name, root_dir, logger) + + result,n,l,t = submod.status() + if toplevel or not submod.toplevel(): + print(wrapper.fill(result)) + testfails += t + localmods += l + needsupdate += n + subdir = os.path.join(root_dir, submod.path) + if os.path.exists(os.path.join(subdir, ".gitmodules")): + gsubmod = GitModules(logger, confpath=subdir) + t,l,n = submodules_status(gsubmod, subdir, depth=depth+1) + if toplevel or not submod.toplevel(): + testfails += t + localmods += l + needsupdate += n + + return testfails, localmods, needsupdate + +def git_toplevelroot(root_dir, logger): + rgit = GitInterface(root_dir, logger) + superroot = rgit.git_operation("rev-parse", "--show-superproject-working-tree") + return superroot + +def submodules_update(gitmodules, root_dir, requiredlist, force): + for name in gitmodules.sections(): + submod = init_submodule_from_gitmodules(gitmodules, name, root_dir, logger) + + _, needsupdate, localmods, testfails = submod.status() + if not submod.fxrequired: + submod.fxrequired = "AlwaysRequired" + fxrequired = submod.fxrequired + allowedvalues = fxrequired_allowed_values() + assert fxrequired in allowedvalues + + superroot = git_toplevelroot(root_dir, logger) + + if ( + fxrequired + and ((superroot and "Toplevel" in fxrequired) + or fxrequired not in requiredlist) + ): + if "Optional" in fxrequired and "Optional" not in requiredlist: + if fxrequired.startswith("Always"): + print(f"Skipping optional component {name:>20}") + continue + optional = "AlwaysOptional" in requiredlist + + if fxrequired in requiredlist: + submod.update() + repodir = os.path.join(root_dir, submod.path) + if os.path.exists(os.path.join(repodir, ".gitmodules")): + # recursively handle this checkout + print(f"Recursively checking out submodules of {name}") + gitsubmodules = GitModules(submod.logger, confpath=repodir) + newrequiredlist = ["AlwaysRequired"] + if optional: + newrequiredlist.append("AlwaysOptional") + + submodules_update(gitsubmodules, repodir, newrequiredlist, force=force) + +def local_mods_output(): + text = """\ + The submodules labeled with 'M' above are not in a clean state. + The following are options for how to proceed: + (1) Go into each submodule which is not in a clean state and issue a 'git status' + Either revert or commit your changes so that the submodule is in a clean state. + (2) use the --force option to git-fleximod + (3) you can name the particular submodules to update using the git-fleximod command line + (4) As a last resort you can remove the submodule (via 'rm -fr [directory]') + then rerun git-fleximod update. +""" + print(text) + +def submodules_test(gitmodules, root_dir): + """ + This function tests the git submodules based on the provided parameters. + + It first checks that fxtags are present and in sync with submodule hashes. + Then it ensures that urls are consistent with fxurls (not forks and not ssh) + and that sparse checkout files exist. + + Parameters: + gitmodules (ConfigParser): The gitmodules configuration. + root_dir (str): The root directory for the git operation. + + Returns: + int: The number of test failures. + """ + # First check that fxtags are present and in sync with submodule hashes + testfails, localmods, needsupdate = submodules_status(gitmodules, root_dir) + print("") + # Then make sure that urls are consistant with fxurls (not forks and not ssh) + # and that sparse checkout files exist + for name in gitmodules.sections(): + url = gitmodules.get(name, "url") + fxurl = gitmodules.get(name, "fxDONOTUSEurl") + fxsparse = gitmodules.get(name, "fxsparse") + path = gitmodules.get(name, "path") + fxurl = fxurl[:-4] if fxurl.endswith(".git") else fxurl + url = url[:-4] if url.endswith(".git") else url + if not fxurl or url.lower() != fxurl.lower(): + print(f"{name:>20} url {url} not in sync with required {fxurl}") + testfails += 1 + if fxsparse and not os.path.isfile(os.path.join(root_dir, path, fxsparse)): + print(f"{name:>20} sparse checkout file {fxsparse} not found") + testfails += 1 + return testfails + localmods + needsupdate + + +def main(): + ( + root_dir, + file_name, + fxrequired, + includelist, + excludelist, + force, + action, + ) = commandline_arguments() + # Get a logger for the package + global logger + logger = logging.getLogger(__name__) + + logger.info("action is {} root_dir={} file_name={}".format(action, root_dir, file_name)) + + if not root_dir or not os.path.isfile(os.path.join(root_dir, file_name)): + if root_dir: + file_path = utils.find_upwards(root_dir, file_name) + + if root_dir is None or file_path is None: + root_dir = "." + utils.fatal_error( + "No {} found in {} or any of it's parents".format(file_name, root_dir) + ) + + root_dir = os.path.dirname(file_path) + logger.info( + "root_dir is {} includelist={} excludelist={}".format( + root_dir, includelist, excludelist + ) + ) + gitmodules = GitModules( + logger, + confpath=root_dir, + conffile=file_name, + includelist=includelist, + excludelist=excludelist, + ) + if not gitmodules.sections(): + sys.exit("No submodule components found") + retval = 0 + if action == "update": + submodules_update(gitmodules, root_dir, fxrequired, force) + elif action == "status": + tfails, lmods, updates = submodules_status(gitmodules, root_dir, toplevel=True) + if tfails + lmods + updates > 0: + print( + f" testfails = {tfails}, local mods = {lmods}, needs updates {updates}\n" + ) + if lmods > 0: + local_mods_output() + elif action == "test": + retval = submodules_test(gitmodules, root_dir) + else: + utils.fatal_error(f"unrecognized action request {action}") + return retval + + +if __name__ == "__main__": + sys.exit(main()) diff --git a/.lib/git-fleximod/git_fleximod/gitinterface.py b/.lib/git-fleximod/git_fleximod/gitinterface.py new file mode 100644 index 0000000000..5831201446 --- /dev/null +++ b/.lib/git-fleximod/git_fleximod/gitinterface.py @@ -0,0 +1,89 @@ +import os +import sys +from . import utils +from pathlib import Path + +class GitInterface: + def __init__(self, repo_path, logger): + logger.debug("Initialize GitInterface for {}".format(repo_path)) + if isinstance(repo_path, str): + self.repo_path = Path(repo_path).resolve() + elif isinstance(repo_path, Path): + self.repo_path = repo_path.resolve() + else: + raise TypeError("repo_path must be a str or Path object") + self.logger = logger + try: + import git + + self._use_module = True + try: + self.repo = git.Repo(str(self.repo_path)) # Initialize GitPython repo + except git.exc.InvalidGitRepositoryError: + self.git = git + self._init_git_repo() + msg = "Using GitPython interface to git" + except ImportError: + self._use_module = False + if not (self.repo_path / ".git").exists(): + self._init_git_repo() + msg = "Using shell interface to git" + self.logger.info(msg) + + def _git_command(self, operation, *args): + self.logger.info(operation) + if self._use_module and operation != "submodule": + try: + return getattr(self.repo.git, operation)(*args) + except Exception as e: + sys.exit(e) + else: + return ["git", "-C", str(self.repo_path), operation] + list(args) + + def _init_git_repo(self): + if self._use_module: + self.repo = self.git.Repo.init(str(self.repo_path)) + else: + command = ("git", "-C", str(self.repo_path), "init") + utils.execute_subprocess(command) + + # pylint: disable=unused-argument + def git_operation(self, operation, *args, **kwargs): + newargs = [] + for a in args: + # Do not use ssh interface + if isinstance(a, str): + a = a.replace("git@github.com:", "https://github.com/") + newargs.append(a) + + command = self._git_command(operation, *newargs) + if isinstance(command, list): + try: + return utils.execute_subprocess(command, output_to_caller=True) + except Exception as e: + sys.exit(e) + else: + return command + + def config_get_value(self, section, name): + if self._use_module: + config = self.repo.config_reader() + try: + val = config.get_value(section, name) + except: + val = None + return val + else: + cmd = ("git", "-C", str(self.repo_path), "config", "--get", f"{section}.{name}") + output = utils.execute_subprocess(cmd, output_to_caller=True) + return output.strip() + + def config_set_value(self, section, name, value): + if self._use_module: + with self.repo.config_writer() as writer: + writer.set_value(section, name, value) + writer.release() # Ensure changes are saved + else: + cmd = ("git", "-C", str(self.repo_path), "config", f"{section}.{name}", value) + self.logger.info(cmd) + utils.execute_subprocess(cmd, output_to_caller=True) diff --git a/.lib/git-fleximod/git_fleximod/gitmodules.py b/.lib/git-fleximod/git_fleximod/gitmodules.py new file mode 100644 index 0000000000..cf8b350dd6 --- /dev/null +++ b/.lib/git-fleximod/git_fleximod/gitmodules.py @@ -0,0 +1,97 @@ +import shutil, os +from pathlib import Path +from configparser import RawConfigParser, ConfigParser +from .lstripreader import LstripReader + + +class GitModules(RawConfigParser): + def __init__( + self, + logger, + confpath=Path.cwd(), + conffile=".gitmodules", + includelist=None, + excludelist=None, + ): + """ + confpath: Path to the directory containing the .gitmodules file (defaults to the current working directory). + conffile: Name of the configuration file (defaults to .gitmodules). + includelist: Optional list of submodules to include. + excludelist: Optional list of submodules to exclude. + """ + self.logger = logger + self.logger.debug( + "Creating a GitModules object {} {} {} {}".format( + confpath, conffile, includelist, excludelist + ) + ) + super().__init__() + self.conf_file = (Path(confpath) / Path(conffile)) + if self.conf_file.exists(): + self.read_file(LstripReader(str(self.conf_file)), source=conffile) + self.includelist = includelist + self.excludelist = excludelist + self.isdirty = False + + def reload(self): + self.clear() + if self.conf_file.exists(): + self.read_file(LstripReader(str(self.conf_file)), source=self.conf_file) + + + def set(self, name, option, value): + """ + Sets a configuration value for a specific submodule: + Ensures the appropriate section exists for the submodule. + Calls the parent class's set method to store the value. + """ + self.isdirty = True + self.logger.debug("set called {} {} {}".format(name, option, value)) + section = f'submodule "{name}"' + if not self.has_section(section): + self.add_section(section) + super().set(section, option, str(value)) + + # pylint: disable=redefined-builtin, arguments-differ + def get(self, name, option, raw=False, vars=None, fallback=None): + """ + Retrieves a configuration value for a specific submodule: + Uses the parent class's get method to access the value. + Handles potential errors if the section or option doesn't exist. + """ + self.logger.debug("git get called {} {}".format(name, option)) + section = f'submodule "{name}"' + try: + return ConfigParser.get( + self, section, option, raw=raw, vars=vars, fallback=fallback + ) + except ConfigParser.NoOptionError: + return None + + def save(self): + if self.isdirty: + self.logger.info("Writing {}".format(self.conf_file)) + with open(self.conf_file, "w") as fd: + self.write(fd) + self.isdirty = False + + def __del__(self): + self.save() + + def sections(self): + """Strip the submodule part out of section and just use the name""" + self.logger.debug("calling GitModules sections iterator") + names = [] + for section in ConfigParser.sections(self): + name = section[11:-1] + if self.includelist and name not in self.includelist: + continue + if self.excludelist and name in self.excludelist: + continue + names.append(name) + return names + + def items(self, name, raw=False, vars=None): + self.logger.debug("calling GitModules items for {}".format(name)) + section = f'submodule "{name}"' + return ConfigParser.items(section, raw=raw, vars=vars) diff --git a/.lib/git-fleximod/git_fleximod/lstripreader.py b/.lib/git-fleximod/git_fleximod/lstripreader.py new file mode 100644 index 0000000000..01d5580ee8 --- /dev/null +++ b/.lib/git-fleximod/git_fleximod/lstripreader.py @@ -0,0 +1,43 @@ +class LstripReader(object): + "LstripReader formats .gitmodules files to be acceptable for configparser" + + def __init__(self, filename): + with open(filename, "r") as infile: + lines = infile.readlines() + self._lines = list() + self._num_lines = len(lines) + self._index = 0 + for line in lines: + self._lines.append(line.lstrip()) + + def readlines(self): + """Return all the lines from this object's file""" + return self._lines + + def readline(self, size=-1): + """Format and return the next line or raise StopIteration""" + try: + line = self.next() + except StopIteration: + line = "" + + if (size > 0) and (len(line) < size): + return line[0:size] + + return line + + def __iter__(self): + """Begin an iteration""" + self._index = 0 + return self + + def next(self): + """Return the next line or raise StopIteration""" + if self._index >= self._num_lines: + raise StopIteration + + self._index = self._index + 1 + return self._lines[self._index - 1] + + def __next__(self): + return self.next() diff --git a/.lib/git-fleximod/git_fleximod/metoflexi.py b/.lib/git-fleximod/git_fleximod/metoflexi.py new file mode 100755 index 0000000000..cc347db2dd --- /dev/null +++ b/.lib/git-fleximod/git_fleximod/metoflexi.py @@ -0,0 +1,236 @@ +#!/usr/bin/env python +from configparser import ConfigParser +import sys +import shutil +from pathlib import Path +import argparse +import logging +from git_fleximod.gitinterface import GitInterface +from git_fleximod.gitmodules import GitModules +from git_fleximod import utils + +logger = None + +def find_root_dir(filename=".git"): + d = Path.cwd() + root = Path(d.root) + while d != root: + attempt = d / filename + if attempt.is_dir(): + return d + d = d.parent + return None + + +def get_parser(): + description = """ + %(prog)s manages checking out groups of gitsubmodules with addtional support for Earth System Models + """ + parser = argparse.ArgumentParser( + description=description, formatter_class=argparse.RawDescriptionHelpFormatter + ) + + parser.add_argument('-e', '--externals', nargs='?', + default='Externals.cfg', + help='The externals description filename. ' + 'Default: %(default)s.') + + parser.add_argument( + "-C", + "--path", + default=find_root_dir(), + help="Toplevel repository directory. Defaults to top git directory relative to current.", + ) + + parser.add_argument( + "-g", + "--gitmodules", + nargs="?", + default=".gitmodules", + help="The submodule description filename. " "Default: %(default)s.", + ) + parser.add_argument( + "-v", + "--verbose", + action="count", + default=0, + help="Output additional information to " + "the screen and log file. This flag can be " + "used up to two times, increasing the " + "verbosity level each time.", + ) + parser.add_argument( + "-d", + "--debug", + action="store_true", + default=False, + help="DEVELOPER: output additional debugging " + "information to the screen and log file.", + ) + + return parser + +def commandline_arguments(args=None): + parser = get_parser() + + options = parser.parse_args(args) + handlers = [logging.StreamHandler()] + + if options.debug: + try: + open("fleximod.log", "w") + except PermissionError: + sys.exit("ABORT: Could not write file fleximod.log") + level = logging.DEBUG + handlers.append(logging.FileHandler("fleximod.log")) + elif options.verbose: + level = logging.INFO + else: + level = logging.WARNING + # Configure the root logger + logging.basicConfig( + level=level, format="%(name)s - %(levelname)s - %(message)s", handlers=handlers + ) + + return( + options.path, + options.gitmodules, + options.externals + ) + +class ExternalRepoTranslator: + """ + Translates external repositories configured in an INI-style externals file. + """ + + def __init__(self, rootpath, gitmodules, externals): + self.rootpath = rootpath + if gitmodules: + self.gitmodules = GitModules(logger, confpath=rootpath) + self.externals = (rootpath / Path(externals)).resolve() + print(f"Translating {self.externals}") + self.git = GitInterface(rootpath, logger) + +# def __del__(self): +# if (self.rootpath / "save.gitignore"): + + + def translate_single_repo(self, section, tag, url, path, efile, hash_, sparse, protocol): + """ + Translates a single repository based on configuration details. + + Args: + rootpath (str): Root path of the main repository. + gitmodules (str): Path to the .gitmodules file. + tag (str): The tag to use for the external repository. + url (str): The URL of the external repository. + path (str): The relative path within the main repository for the external repository. + efile (str): The external file or file containing submodules. + hash_ (str): The commit hash to checkout (if applicable). + sparse (str): Boolean indicating whether to use sparse checkout (if applicable). + protocol (str): The protocol to use (e.g., 'git', 'http'). + """ + assert protocol != "svn", "SVN protocol is not currently supported" + print(f"Translating repository {section}") + if efile: + file_path = Path(path) / Path(efile) + newroot = (self.rootpath / file_path).parent.resolve() + if not newroot.exists(): + newroot.mkdir(parents=True) + logger.info("Newroot is {}".format(newroot)) + newt = ExternalRepoTranslator(newroot, ".gitmodules", efile) + newt.translate_repo() + if protocol == "externals_only": + if tag: + self.gitmodules.set(section, "fxtag", tag) + if hash_: + self.gitmodules.set(section, "fxtag", hash_) + + self.gitmodules.set(section, "fxDONOTUSEurl", url) + if sparse: + self.gitmodules.set(section, "fxsparse", sparse) + self.gitmodules.set(section, "fxrequired", "ToplevelRequired") + else: + newpath = (self.rootpath / Path(path)) + if newpath.exists(): + shutil.rmtree(newpath) + logger.info("Creating directory {}".format(newpath)) + newpath.mkdir(parents=True) + if tag: + logger.info("cloning {}".format(section)) + try: + self.git.git_operation("clone", "-b", tag, "--depth", "1", url, path) + except: + self.git.git_operation("clone", url, path) + with utils.pushd(newpath): + ngit = GitInterface(newpath, logger) + ngit.git_operation("checkout", tag) + if hash_: + self.git.git_operation("clone", url, path) + git = GitInterface(newpath, logger) + git.git_operation("fetch", "origin") + git.git_operation("checkout", hash_) + if sparse: + print("setting as sparse submodule {}".format(section)) + sparsefile = (newpath / Path(sparse)) + newfile = (newpath / ".git" / "info" / "sparse-checkout") + print(f"sparsefile {sparsefile} newfile {newfile}") + shutil.copy(sparsefile, newfile) + + logger.info("adding submodule {}".format(section)) + self.gitmodules.save() + self.git.git_operation("submodule", "add", "-f", "--name", section, url, path) + self.git.git_operation("submodule","absorbgitdirs") + self.gitmodules.reload() + if tag: + self.gitmodules.set(section, "fxtag", tag) + if hash_: + self.gitmodules.set(section, "fxtag", hash_) + + self.gitmodules.set(section, "fxDONOTUSEurl", url) + if sparse: + self.gitmodules.set(section, "fxsparse", sparse) + self.gitmodules.set(section, "fxrequired", "ToplevelRequired") + + + def translate_repo(self): + """ + Translates external repositories defined within an external file. + + Args: + rootpath (str): Root path of the main repository. + gitmodules (str): Path to the .gitmodules file. + external_file (str): The path to the external file containing repository definitions. + """ + econfig = ConfigParser() + econfig.read((self.rootpath / Path(self.externals))) + + for section in econfig.sections(): + if section == "externals_description": + logger.info("skipping section {}".format(section)) + return + logger.info("Translating section {}".format(section)) + tag = econfig.get(section, "tag", raw=False, fallback=None) + url = econfig.get(section, "repo_url", raw=False, fallback=None) + path = econfig.get(section, "local_path", raw=False, fallback=None) + efile = econfig.get(section, "externals", raw=False, fallback=None) + hash_ = econfig.get(section, "hash", raw=False, fallback=None) + sparse = econfig.get(section, "sparse", raw=False, fallback=None) + protocol = econfig.get(section, "protocol", raw=False, fallback=None) + + self.translate_single_repo(section, tag, url, path, efile, hash_, sparse, protocol) + + + +def _main(): + rootpath, gitmodules, externals = commandline_arguments() + global logger + logger = logging.getLogger(__name__) + with utils.pushd(rootpath): + t = ExternalRepoTranslator(Path(rootpath), gitmodules, externals) + logger.info("Translating {}".format(rootpath)) + t.translate_repo() + + +if __name__ == "__main__": + sys.exit(_main()) diff --git a/.lib/git-fleximod/git_fleximod/submodule.py b/.lib/git-fleximod/git_fleximod/submodule.py new file mode 100644 index 0000000000..70a3018a42 --- /dev/null +++ b/.lib/git-fleximod/git_fleximod/submodule.py @@ -0,0 +1,416 @@ +import os +import textwrap +import shutil +import string +from configparser import NoOptionError +from git_fleximod import utils +from git_fleximod.gitinterface import GitInterface + +class Submodule(): + """ + Represents a Git submodule with enhanced features for flexible management. + + Attributes: + name (str): The name of the submodule. + root_dir (str): The root directory of the main project. + path (str): The relative path from the root directory to the submodule. + url (str): The URL of the submodule repository. + fxurl (str): The URL for flexible submodule management (optional). + fxtag (str): The tag for flexible submodule management (optional). + fxsparse (str): Path to the sparse checkout file relative to the submodule path, see git-sparse-checkout for details (optional). + fxrequired (str): Indicates if the submodule is optional or required (optional). + logger (logging.Logger): Logger instance for logging (optional). + """ + def __init__(self, root_dir, name, path, url, fxtag=None, fxurl=None, fxsparse=None, fxrequired=None, logger=None): + """ + Initializes a new Submodule instance with the provided attributes. + """ + self.name = name + self.root_dir = root_dir + self.path = path + self.url = url + self.fxurl = fxurl + self.fxtag = fxtag + self.fxsparse = fxsparse + if fxrequired: + self.fxrequired = fxrequired + else: + self.fxrequired = "AlwaysRequired" + self.logger = logger + + def status(self): + """ + Checks the status of the submodule and returns 4 parameters: + - result (str): The status of the submodule. + - needsupdate (bool): An indicator if the submodule needs to be updated. + - localmods (bool): An indicator if the submodule has local modifications. + - testfails (bool): An indicator if the submodule has failed a test, this is used for testing purposes. + """ + + smpath = os.path.join(self.root_dir, self.path) + testfails = False + localmods = False + needsupdate = False + ahash = None + optional = "" + if "Optional" in self.fxrequired: + optional = " (optional)" + required = None + level = None + if not os.path.exists(os.path.join(smpath, ".git")): + rootgit = GitInterface(self.root_dir, self.logger) + # submodule commands use path, not name + tags = rootgit.git_operation("ls-remote", "--tags", self.url) + result = rootgit.git_operation("submodule","status",smpath).split() + + if result: + ahash = result[0][1:] + hhash = None + atag = None + for htag in tags.split("\n"): + if htag.endswith('^{}'): + htag = htag[:-3] + if ahash and not atag and ahash in htag: + atag = (htag.split()[1])[10:] + if self.fxtag and not hhash and htag.endswith(self.fxtag): + hhash = htag.split()[0] + if hhash and atag: + break + if self.fxtag and (ahash == hhash or atag == self.fxtag): + result = f"e {self.name:>20} not checked out, aligned at tag {self.fxtag}{optional}" + needsupdate = True + elif self.fxtag: + ahash = rootgit.git_operation( + "submodule", "status", "{}".format(self.path) + ).rstrip() + ahash = ahash[1 : len(self.fxtag) + 1] + if self.fxtag == ahash: + result = f"e {self.name:>20} not checked out, aligned at hash {ahash}{optional}" + else: + result = f"e {self.name:>20} not checked out, out of sync at tag {atag}, expected tag is {self.fxtag}{optional}" + testfails = True + needsupdate = True + else: + result = f"e {self.name:>20} has no fxtag defined in .gitmodules{optional}" + testfails = False + else: + with utils.pushd(smpath): + git = GitInterface(smpath, self.logger) + remote = git.git_operation("remote").rstrip() + if remote == '': + result = f"e {self.name:>20} has no associated remote" + testfails = True + needsupdate = True + return result, needsupdate, localmods, testfails + rurl = git.git_operation("ls-remote","--get-url").rstrip() + line = git.git_operation("log", "--pretty=format:\"%h %d\"").partition('\n')[0] + parts = line.split() + ahash = parts[0][1:] + atag = None + if len(parts) > 3: + idx = 0 + while idx < len(parts)-1: + idx = idx+1 + if parts[idx] == 'tag:': + atag = parts[idx+1] + while atag.endswith(')') or atag.endswith(',') or atag.endswith("\""): + atag = atag[:-1] + if atag == self.fxtag: + break + + + #print(f"line is {line} ahash is {ahash} atag is {atag} {parts}") + # atag = git.git_operation("describe", "--tags", "--always").rstrip() + # ahash = git.git_operation("rev-list", "HEAD").partition("\n")[0] + + recurse = False + if rurl != self.url: + remote = self._add_remote(git) + git.git_operation("fetch", remote) + if self.fxtag and atag == self.fxtag: + result = f" {self.name:>20} at tag {self.fxtag}" + recurse = True + testfails = False + elif self.fxtag and (ahash[: len(self.fxtag)] == self.fxtag or (self.fxtag.find(ahash)==0)): + result = f" {self.name:>20} at hash {ahash}" + recurse = True + testfails = False + elif atag == ahash: + result = f" {self.name:>20} at hash {ahash}" + recurse = True + elif self.fxtag: + result = f"s {self.name:>20} {atag} {ahash} is out of sync with .gitmodules {self.fxtag}" + testfails = True + needsupdate = True + else: + if atag: + result = f"e {self.name:>20} has no fxtag defined in .gitmodules, module at {atag}" + else: + result = f"e {self.name:>20} has no fxtag defined in .gitmodules, module at {ahash}" + testfails = False + + status = git.git_operation("status", "--ignore-submodules", "-uno") + if "nothing to commit" not in status: + localmods = True + result = "M" + textwrap.indent(status, " ") +# print(f"result {result} needsupdate {needsupdate} localmods {localmods} testfails {testfails}") + return result, needsupdate, localmods, testfails + + + def _add_remote(self, git): + """ + Adds a new remote to the submodule if it does not already exist. + + This method checks the existing remotes of the submodule. If the submodule's URL is not already listed as a remote, + it attempts to add a new remote. The name for the new remote is generated dynamically to avoid conflicts. If no + remotes exist, it defaults to naming the new remote 'origin'. + + Args: + git (GitInterface): An instance of GitInterface to perform git operations. + + Returns: + str: The name of the new remote if added, or the name of the existing remote that matches the submodule's URL. + """ + remotes = git.git_operation("remote", "-v").splitlines() + upstream = None + if remotes: + upstream = git.git_operation("ls-remote", "--get-url").rstrip() + newremote = "newremote.00" + tmpurl = self.url.replace("git@github.com:", "https://github.com/") + line = next((s for s in remotes if self.url in s or tmpurl in s), None) + if line: + newremote = line.split()[0] + return newremote + else: + i = 0 + while "newremote" in remotes: + i = i + 1 + newremote = f"newremote.{i:02d}" + else: + newremote = "origin" + git.git_operation("remote", "add", newremote, self.url) + return newremote + + def toplevel(self): + """ + Returns True if the submodule is Toplevel (either Required or Optional) + """ + return True if "Top" in self.fxrequired else False + + def sparse_checkout(self): + """ + Performs a sparse checkout of the submodule. + + This method optimizes the checkout process by only checking out files specified in the submodule's sparse-checkout configuration, + rather than the entire submodule content. It achieves this by first ensuring the `.git/info/sparse-checkout` file is created and + configured in the submodule's directory. Then, it proceeds to checkout the desired tag. If the submodule has already been checked out, + this method will not perform the checkout again. + + This approach is particularly beneficial for submodules with a large number of files, as it significantly reduces the time and disk space + required for the checkout process by avoiding the unnecessary checkout and subsequent removal of unneeded files. + + Returns: + None + """ + self.logger.info("Called sparse_checkout for {}".format(self.name)) + rgit = GitInterface(self.root_dir, self.logger) + superroot = rgit.git_operation("rev-parse", "--show-superproject-working-tree") + if superroot: + gitroot = superroot.strip() + else: + gitroot = self.root_dir.strip() + assert os.path.isdir(os.path.join(gitroot, ".git")) + # first create the module directory + if not os.path.isdir(os.path.join(self.root_dir, self.path)): + os.makedirs(os.path.join(self.root_dir, self.path)) + + # initialize a new git repo and set the sparse checkout flag + sprep_repo = os.path.join(self.root_dir, self.path) + sprepo_git = GitInterface(sprep_repo, self.logger) + if os.path.exists(os.path.join(sprep_repo, ".git")): + try: + self.logger.info("Submodule {} found".format(self.name)) + chk = sprepo_git.config_get_value("core", "sparseCheckout") + if chk == "true": + self.logger.info("Sparse submodule {} already checked out".format(self.name)) + return + except (NoOptionError): + self.logger.debug("Sparse submodule {} not present".format(self.name)) + except Exception as e: + utils.fatal_error("Unexpected error {} occured.".format(e)) + + sprepo_git.config_set_value("core", "sparseCheckout", "true") + + # set the repository remote + + self.logger.info("Setting remote origin in {}/{}".format(self.root_dir, self.path)) + status = sprepo_git.git_operation("remote", "-v") + if self.url not in status: + sprepo_git.git_operation("remote", "add", "origin", self.url) + + topgit = os.path.join(gitroot, ".git") + + if gitroot != self.root_dir and os.path.isfile(os.path.join(self.root_dir, ".git")): + with open(os.path.join(self.root_dir, ".git")) as f: + gitpath = os.path.relpath( + os.path.join(self.root_dir, f.read().split()[1]), + start=os.path.join(self.root_dir, self.path), + ) + topgit = os.path.join(gitpath, "modules") + else: + topgit = os.path.relpath( + os.path.join(self.root_dir, ".git", "modules"), + start=os.path.join(self.root_dir, self.path), + ) + + with utils.pushd(sprep_repo): + if not os.path.isdir(topgit): + os.makedirs(topgit) + topgit += os.sep + self.name + + if os.path.isdir(os.path.join(self.root_dir, self.path, ".git")): + with utils.pushd(sprep_repo): + if os.path.isdir(os.path.join(topgit,".git")): + shutil.rmtree(os.path.join(topgit,".git")) + shutil.move(".git", topgit) + with open(".git", "w") as f: + f.write("gitdir: " + os.path.relpath(topgit)) + # assert(os.path.isdir(os.path.relpath(topgit, start=sprep_repo))) + gitsparse = os.path.abspath(os.path.join(topgit, "info", "sparse-checkout")) + if os.path.isfile(gitsparse): + self.logger.warning( + "submodule {} is already initialized {}".format(self.name, topgit) + ) + return + + with utils.pushd(sprep_repo): + if os.path.isfile(self.fxsparse): + shutil.copy(self.fxsparse, gitsparse) + + + # Finally checkout the repo + sprepo_git.git_operation("fetch", "origin", "--tags") + sprepo_git.git_operation("checkout", self.fxtag) + + print(f"Successfully checked out {self.name:>20} at {self.fxtag}") + rgit.config_set_value(f'submodule "{self.name}"', "active", "true") + rgit.config_set_value(f'submodule "{self.name}"', "url", self.url) + rgit.config_set_value(f'submodule "{self.name}"', "path", self.path) + + def update(self): + """ + Updates the submodule to the latest or specified version. + + This method handles the update process of the submodule, including checking out the submodule into the specified path, + handling sparse checkouts if configured, and updating the submodule's URL if necessary. It supports both SSH and HTTPS URLs, + automatically converting SSH URLs to HTTPS to avoid issues for users without SSH keys. + + The update process involves the following steps: + 1. If the submodule is configured for sparse checkout, it performs a sparse checkout. + 2. If the submodule is not already checked out, it clones the submodule using the provided URL. + 3. If a specific tag or hash is provided, it checks out that tag; otherwise, it checks out the latest version. + 4. If the root `.git` is a file (indicating a submodule or a worktree), additional steps are taken to integrate the submodule properly. + + Args: + None + Note: + - SSH URLs are automatically converted to HTTPS to accommodate users without SSH keys. + + Returns: + None + """ + git = GitInterface(self.root_dir, self.logger) + repodir = os.path.join(self.root_dir, self.path) + self.logger.info("Checkout {} into {}/{}".format(self.name, self.root_dir, self.path)) + # if url is provided update to the new url + tag = None + repo_exists = False + if os.path.exists(os.path.join(repodir, ".git")): + self.logger.info("Submodule {} already checked out".format(self.name)) + repo_exists = True + # Look for a .gitmodules file in the newly checkedout repo + if self.fxsparse: + print(f"Sparse checkout {self.name} fxsparse {self.fxsparse}") + self.sparse_checkout() + else: + if not repo_exists and self.url: + # ssh urls cause problems for those who dont have git accounts with ssh keys defined + # but cime has one since e3sm prefers ssh to https, because the .gitmodules file was + # opened with a GitModules object we don't need to worry about restoring the file here + # it will be done by the GitModules class + if self.url.startswith("git@"): + git.git_operation("clone", self.url, self.path) + smgit = GitInterface(repodir, self.logger) + if not tag: + tag = smgit.git_operation("describe", "--tags", "--always").rstrip() + smgit.git_operation("checkout", tag) + # Now need to move the .git dir to the submodule location + rootdotgit = os.path.join(self.root_dir, ".git") + if os.path.isfile(rootdotgit): + with open(rootdotgit) as f: + line = f.readline() + if line.startswith("gitdir: "): + rootdotgit = line[8:].rstrip() + + newpath = os.path.abspath(os.path.join(self.root_dir, rootdotgit, "modules", self.name)) + if os.path.exists(newpath): + shutil.rmtree(os.path.join(repodir, ".git")) + else: + shutil.move(os.path.join(repodir, ".git"), newpath) + + with open(os.path.join(repodir, ".git"), "w") as f: + f.write("gitdir: " + os.path.relpath(newpath, start=repodir)) + + if not os.path.exists(repodir): + parent = os.path.dirname(repodir) + if not os.path.isdir(parent): + os.makedirs(parent) + git.git_operation("submodule", "add", "--name", self.name, "--", self.url, self.path) + + if not repo_exists: + git.git_operation("submodule", "update", "--init", "--", self.path) + + if self.fxtag: + smgit = GitInterface(repodir, self.logger) + newremote = self._add_remote(smgit) + # Trying to distingush a tag from a hash + allowed = set(string.digits + 'abcdef') + if not set(self.fxtag) <= allowed: + # This is a tag + tag = f"refs/tags/{self.fxtag}:refs/tags/{self.fxtag}" + smgit.git_operation("fetch", newremote, tag) + smgit.git_operation("checkout", self.fxtag) + + if not os.path.exists(os.path.join(repodir, ".git")): + utils.fatal_error( + f"Failed to checkout {self.name} {repo_exists} {repodir} {self.path}" + ) + + + if os.path.exists(os.path.join(self.path, ".git")): + submoddir = os.path.join(self.root_dir, self.path) + with utils.pushd(submoddir): + git = GitInterface(submoddir, self.logger) + # first make sure the url is correct + newremote = self._add_remote(git) + tags = git.git_operation("tag", "-l") + fxtag = self.fxtag + if fxtag and fxtag not in tags: + git.git_operation("fetch", newremote, "--tags") + atag = git.git_operation("describe", "--tags", "--always").rstrip() + if fxtag and fxtag != atag: + try: + git.git_operation("checkout", fxtag) + print(f"{self.name:>20} updated to {fxtag}") + except Exception as error: + print(error) + + + elif not fxtag: + print(f"No fxtag found for submodule {self.name:>20}") + else: + print(f"{self.name:>20} up to date.") + + + + return diff --git a/manage_externals/manic/utils.py b/.lib/git-fleximod/git_fleximod/utils.py similarity index 64% rename from manage_externals/manic/utils.py rename to .lib/git-fleximod/git_fleximod/utils.py index 9c63ffe65e..1a2d5ccf2f 100644 --- a/manage_externals/manic/utils.py +++ b/.lib/git-fleximod/git_fleximod/utils.py @@ -4,23 +4,31 @@ """ -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - import logging import os import subprocess import sys from threading import Timer +from pathlib import Path -from .global_constants import LOCAL_PATH_INDICATOR - +LOCAL_PATH_INDICATOR = "." # --------------------------------------------------------------------- # -# screen and logging output and functions to massage text for output +# functions to massage text for output and other useful utilities # # --------------------------------------------------------------------- +from contextlib import contextmanager + + +@contextmanager +def pushd(new_dir): + """context for chdir. usage: with pushd(new_dir)""" + previous_dir = os.getcwd() + os.chdir(new_dir) + try: + yield + finally: + os.chdir(previous_dir) def log_process_output(output): @@ -30,7 +38,7 @@ def log_process_output(output): line. This makes it hard to filter with grep. """ - output = output.split('\n') + output = output.split("\n") for line in output: logging.debug(line) @@ -48,6 +56,18 @@ def printlog(msg, **kwargs): sys.stdout.flush() +def find_upwards(root_dir, filename): + """Find a file in root dir or any of it's parents""" + d = Path(root_dir) + root = Path(d.root) + while d != root: + attempt = d / filename + if attempt.exists(): + return attempt + d = d.parent + return None + + def last_n_lines(the_string, n_lines, truncation_message=None): """Returns the last n lines of the given string @@ -68,9 +88,9 @@ def last_n_lines(the_string, n_lines, truncation_message=None): return_val = the_string else: lines_subset = lines[-n_lines:] - str_truncated = ''.join(lines_subset) + str_truncated = "".join(lines_subset) if truncation_message: - str_truncated = truncation_message + '\n' + str_truncated + str_truncated = truncation_message + "\n" + str_truncated return_val = str_truncated return return_val @@ -90,9 +110,10 @@ def indent_string(the_string, indent_level): """ lines = the_string.splitlines(True) - padding = ' ' * indent_level + padding = " " * indent_level lines_indented = [padding + line for line in lines] - return ''.join(lines_indented) + return "".join(lines_indented) + # --------------------------------------------------------------------- # @@ -121,24 +142,26 @@ def str_to_bool(bool_str): """ value = None str_lower = bool_str.lower() - if str_lower in ('true', 't'): + if str_lower in ("true", "t"): value = True - elif str_lower in ('false', 'f'): + elif str_lower in ("false", "f"): value = False if value is None: - msg = ('ERROR: invalid boolean string value "{0}". ' - 'Must be "true" or "false"'.format(bool_str)) + msg = ( + 'ERROR: invalid boolean string value "{0}". ' + 'Must be "true" or "false"'.format(bool_str) + ) fatal_error(msg) return value -REMOTE_PREFIXES = ['http://', 'https://', 'ssh://', 'git@'] +REMOTE_PREFIXES = ["http://", "https://", "ssh://", "git@"] def is_remote_url(url): """check if the user provided a local file path instead of a - remote. If so, it must be expanded to an absolute - path. + remote. If so, it must be expanded to an absolute + path. """ remote_url = False @@ -150,7 +173,7 @@ def is_remote_url(url): def split_remote_url(url): """check if the user provided a local file path or a - remote. If remote, try to strip off protocol info. + remote. If remote, try to strip off protocol info. """ remote_url = is_remote_url(url) @@ -158,13 +181,13 @@ def split_remote_url(url): return url for prefix in REMOTE_PREFIXES: - url = url.replace(prefix, '') + url = url.replace(prefix, "") - if '@' in url: - url = url.split('@')[1] + if "@" in url: + url = url.split("@")[1] - if ':' in url: - url = url.split(':')[1] + if ":" in url: + url = url.split(":")[1] return url @@ -186,10 +209,12 @@ def expand_local_url(url, field): url = os.path.expandvars(url) url = os.path.expanduser(url) if not os.path.isabs(url): - msg = ('WARNING: Externals description for "{0}" contains a ' - 'url that is not remote and does not expand to an ' - 'absolute path. Version control operations may ' - 'fail.\n\nurl={1}'.format(field, url)) + msg = ( + 'WARNING: Externals description for "{0}" contains a ' + "url that is not remote and does not expand to an " + "absolute path. Version control operations may " + "fail.\n\nurl={1}".format(field, url) + ) printlog(msg) else: url = os.path.normpath(url) @@ -208,27 +233,30 @@ def expand_local_url(url, field): def _hanging_msg(working_directory, command): - print(""" + print( + """ Command '{command}' from directory {working_directory} has taken {hanging_sec} seconds. It may be hanging. The command will continue to run, but you may want to abort -manage_externals with ^C and investigate. A possible cause of hangs is -when svn or git require authentication to access a private -repository. On some systems, svn and git requests for authentication -information will not be displayed to the user. In this case, the program -will appear to hang. Ensure you can run svn and git manually and access -all repositories without entering your authentication information. - -""".format(command=command, - working_directory=working_directory, - hanging_sec=_HANGING_SEC)) - - -def execute_subprocess(commands, status_to_caller=False, - output_to_caller=False): +git-fleximod with ^C and investigate. A possible cause of hangs is git +requires authentication to access a private repository. On some +systems, git requests for authentication information will not +be displayed to the user. In this case, the program will appear to +hang. Ensure you can run git manually and access all +repositories without entering your authentication information. + +""".format( + command=command, + working_directory=working_directory, + hanging_sec=_HANGING_SEC, + ) + ) + + +def execute_subprocess(commands, status_to_caller=False, output_to_caller=False): """Wrapper around subprocess.check_output to handle common exceptions. @@ -242,32 +270,35 @@ def execute_subprocess(commands, status_to_caller=False, """ cwd = os.getcwd() - msg = 'In directory: {0}\nexecute_subprocess running command:'.format(cwd) + msg = "In directory: {0}\nexecute_subprocess running command:".format(cwd) logging.info(msg) - commands_str = ' '.join(commands) + commands_str = " ".join(str(element) for element in commands) logging.info(commands_str) return_to_caller = status_to_caller or output_to_caller status = -1 - output = '' - hanging_timer = Timer(_HANGING_SEC, _hanging_msg, - kwargs={"working_directory": cwd, - "command": commands_str}) + output = "" + hanging_timer = Timer( + _HANGING_SEC, + _hanging_msg, + kwargs={"working_directory": cwd, "command": commands_str}, + ) hanging_timer.start() try: - output = subprocess.check_output(commands, stderr=subprocess.STDOUT, - universal_newlines=True) + output = subprocess.check_output( + commands, stderr=subprocess.STDOUT, universal_newlines=True + ) log_process_output(output) status = 0 except OSError as error: msg = failed_command_msg( - 'Command execution failed. Does the executable exist?', - commands) + "Command execution failed. Does the executable exist?", commands + ) logging.error(error) fatal_error(msg) except ValueError as error: msg = failed_command_msg( - 'DEV_ERROR: Invalid arguments trying to run subprocess', - commands) + "DEV_ERROR: Invalid arguments trying to run subprocess", commands + ) logging.error(error) fatal_error(msg) except subprocess.CalledProcessError as error: @@ -277,10 +308,11 @@ def execute_subprocess(commands, status_to_caller=False, # responsibility determine if an error occurred and handle it # appropriately. if not return_to_caller: - msg_context = ('Process did not run successfully; ' - 'returned status {0}'.format(error.returncode)) - msg = failed_command_msg(msg_context, commands, - output=error.output) + msg_context = ( + "Process did not run successfully; " + "returned status {0}".format(error.returncode) + ) + msg = failed_command_msg(msg_context, commands, output=error.output) logging.error(error) logging.error(msg) log_process_output(error.output) @@ -309,22 +341,25 @@ def failed_command_msg(msg_context, command, output=None): """ if output: - output_truncated = last_n_lines(output, 20, - truncation_message='[... Output truncated for brevity ...]') - errmsg = ('Failed with output:\n' + - indent_string(output_truncated, 4) + - '\nERROR: ') + output_truncated = last_n_lines( + output, 20, truncation_message="[... Output truncated for brevity ...]" + ) + errmsg = ( + "Failed with output:\n" + indent_string(output_truncated, 4) + "\nERROR: " + ) else: - errmsg = '' + errmsg = "" - command_str = ' '.join(command) + command_str = " ".join(command) errmsg += """In directory {cwd} {context}: {command} -""".format(cwd=os.getcwd(), context=msg_context, command=command_str) +""".format( + cwd=os.getcwd(), context=msg_context, command=command_str + ) if output: - errmsg += 'See above for output from failed command.\n' + errmsg += "See above for output from failed command.\n" return errmsg diff --git a/.lib/git-fleximod/poetry.lock b/.lib/git-fleximod/poetry.lock new file mode 100644 index 0000000000..3a74effcd1 --- /dev/null +++ b/.lib/git-fleximod/poetry.lock @@ -0,0 +1,693 @@ +# This file is automatically @generated by Poetry 1.7.1 and should not be changed by hand. + +[[package]] +name = "alabaster" +version = "0.7.13" +description = "A configurable sidebar-enabled Sphinx theme" +optional = false +python-versions = ">=3.6" +files = [ + {file = "alabaster-0.7.13-py3-none-any.whl", hash = "sha256:1ee19aca801bbabb5ba3f5f258e4422dfa86f82f3e9cefb0859b283cdd7f62a3"}, + {file = "alabaster-0.7.13.tar.gz", hash = "sha256:a27a4a084d5e690e16e01e03ad2b2e552c61a65469419b907243193de1a84ae2"}, +] + +[[package]] +name = "babel" +version = "2.15.0" +description = "Internationalization utilities" +optional = false +python-versions = ">=3.8" +files = [ + {file = "Babel-2.15.0-py3-none-any.whl", hash = "sha256:08706bdad8d0a3413266ab61bd6c34d0c28d6e1e7badf40a2cebe67644e2e1fb"}, + {file = "babel-2.15.0.tar.gz", hash = "sha256:8daf0e265d05768bc6c7a314cf1321e9a123afc328cc635c18622a2f30a04413"}, +] + +[package.dependencies] +pytz = {version = ">=2015.7", markers = "python_version < \"3.9\""} + +[package.extras] +dev = ["freezegun (>=1.0,<2.0)", "pytest (>=6.0)", "pytest-cov"] + +[[package]] +name = "certifi" +version = "2024.6.2" +description = "Python package for providing Mozilla's CA Bundle." +optional = false +python-versions = ">=3.6" +files = [ + {file = "certifi-2024.6.2-py3-none-any.whl", hash = "sha256:ddc6c8ce995e6987e7faf5e3f1b02b302836a0e5d98ece18392cb1a36c72ad56"}, + {file = "certifi-2024.6.2.tar.gz", hash = "sha256:3cd43f1c6fa7dedc5899d69d3ad0398fd018ad1a17fba83ddaf78aa46c747516"}, +] + +[[package]] +name = "charset-normalizer" +version = "3.3.2" +description = "The Real First Universal Charset Detector. Open, modern and actively maintained alternative to Chardet." +optional = false +python-versions = ">=3.7.0" +files = [ + {file = "charset-normalizer-3.3.2.tar.gz", hash = "sha256:f30c3cb33b24454a82faecaf01b19c18562b1e89558fb6c56de4d9118a032fd5"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-macosx_10_9_universal2.whl", hash = "sha256:25baf083bf6f6b341f4121c2f3c548875ee6f5339300e08be3f2b2ba1721cdd3"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-macosx_10_9_x86_64.whl", hash = "sha256:06435b539f889b1f6f4ac1758871aae42dc3a8c0e24ac9e60c2384973ad73027"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-macosx_11_0_arm64.whl", hash = "sha256:9063e24fdb1e498ab71cb7419e24622516c4a04476b17a2dab57e8baa30d6e03"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:6897af51655e3691ff853668779c7bad41579facacf5fd7253b0133308cf000d"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:1d3193f4a680c64b4b6a9115943538edb896edc190f0b222e73761716519268e"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:cd70574b12bb8a4d2aaa0094515df2463cb429d8536cfb6c7ce983246983e5a6"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:8465322196c8b4d7ab6d1e049e4c5cb460d0394da4a27d23cc242fbf0034b6b5"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:a9a8e9031d613fd2009c182b69c7b2c1ef8239a0efb1df3f7c8da66d5dd3d537"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-musllinux_1_1_aarch64.whl", hash = "sha256:beb58fe5cdb101e3a055192ac291b7a21e3b7ef4f67fa1d74e331a7f2124341c"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-musllinux_1_1_i686.whl", hash = "sha256:e06ed3eb3218bc64786f7db41917d4e686cc4856944f53d5bdf83a6884432e12"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-musllinux_1_1_ppc64le.whl", hash = "sha256:2e81c7b9c8979ce92ed306c249d46894776a909505d8f5a4ba55b14206e3222f"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-musllinux_1_1_s390x.whl", hash = "sha256:572c3763a264ba47b3cf708a44ce965d98555f618ca42c926a9c1616d8f34269"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-musllinux_1_1_x86_64.whl", hash = "sha256:fd1abc0d89e30cc4e02e4064dc67fcc51bd941eb395c502aac3ec19fab46b519"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-win32.whl", hash = "sha256:3d47fa203a7bd9c5b6cee4736ee84ca03b8ef23193c0d1ca99b5089f72645c73"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-win_amd64.whl", hash = "sha256:10955842570876604d404661fbccbc9c7e684caf432c09c715ec38fbae45ae09"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-macosx_10_9_universal2.whl", hash = "sha256:802fe99cca7457642125a8a88a084cef28ff0cf9407060f7b93dca5aa25480db"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-macosx_10_9_x86_64.whl", hash = "sha256:573f6eac48f4769d667c4442081b1794f52919e7edada77495aaed9236d13a96"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-macosx_11_0_arm64.whl", hash = "sha256:549a3a73da901d5bc3ce8d24e0600d1fa85524c10287f6004fbab87672bf3e1e"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:f27273b60488abe721a075bcca6d7f3964f9f6f067c8c4c605743023d7d3944f"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:1ceae2f17a9c33cb48e3263960dc5fc8005351ee19db217e9b1bb15d28c02574"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:65f6f63034100ead094b8744b3b97965785388f308a64cf8d7c34f2f2e5be0c4"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:753f10e867343b4511128c6ed8c82f7bec3bd026875576dfd88483c5c73b2fd8"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:4a78b2b446bd7c934f5dcedc588903fb2f5eec172f3d29e52a9096a43722adfc"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-musllinux_1_1_aarch64.whl", hash = "sha256:e537484df0d8f426ce2afb2d0f8e1c3d0b114b83f8850e5f2fbea0e797bd82ae"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-musllinux_1_1_i686.whl", hash = "sha256:eb6904c354526e758fda7167b33005998fb68c46fbc10e013ca97f21ca5c8887"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-musllinux_1_1_ppc64le.whl", hash = "sha256:deb6be0ac38ece9ba87dea880e438f25ca3eddfac8b002a2ec3d9183a454e8ae"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-musllinux_1_1_s390x.whl", hash = "sha256:4ab2fe47fae9e0f9dee8c04187ce5d09f48eabe611be8259444906793ab7cbce"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-musllinux_1_1_x86_64.whl", hash = "sha256:80402cd6ee291dcb72644d6eac93785fe2c8b9cb30893c1af5b8fdd753b9d40f"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-win32.whl", hash = "sha256:7cd13a2e3ddeed6913a65e66e94b51d80a041145a026c27e6bb76c31a853c6ab"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-win_amd64.whl", hash = "sha256:663946639d296df6a2bb2aa51b60a2454ca1cb29835324c640dafb5ff2131a77"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-macosx_10_9_universal2.whl", hash = "sha256:0b2b64d2bb6d3fb9112bafa732def486049e63de9618b5843bcdd081d8144cd8"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-macosx_10_9_x86_64.whl", hash = "sha256:ddbb2551d7e0102e7252db79ba445cdab71b26640817ab1e3e3648dad515003b"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-macosx_11_0_arm64.whl", hash = "sha256:55086ee1064215781fff39a1af09518bc9255b50d6333f2e4c74ca09fac6a8f6"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:8f4a014bc36d3c57402e2977dada34f9c12300af536839dc38c0beab8878f38a"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:a10af20b82360ab00827f916a6058451b723b4e65030c5a18577c8b2de5b3389"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:8d756e44e94489e49571086ef83b2bb8ce311e730092d2c34ca8f7d925cb20aa"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:90d558489962fd4918143277a773316e56c72da56ec7aa3dc3dbbe20fdfed15b"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:6ac7ffc7ad6d040517be39eb591cac5ff87416c2537df6ba3cba3bae290c0fed"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-musllinux_1_1_aarch64.whl", hash = "sha256:7ed9e526742851e8d5cc9e6cf41427dfc6068d4f5a3bb03659444b4cabf6bc26"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-musllinux_1_1_i686.whl", hash = "sha256:8bdb58ff7ba23002a4c5808d608e4e6c687175724f54a5dade5fa8c67b604e4d"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-musllinux_1_1_ppc64le.whl", hash = "sha256:6b3251890fff30ee142c44144871185dbe13b11bab478a88887a639655be1068"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-musllinux_1_1_s390x.whl", hash = "sha256:b4a23f61ce87adf89be746c8a8974fe1c823c891d8f86eb218bb957c924bb143"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-musllinux_1_1_x86_64.whl", hash = "sha256:efcb3f6676480691518c177e3b465bcddf57cea040302f9f4e6e191af91174d4"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-win32.whl", hash = "sha256:d965bba47ddeec8cd560687584e88cf699fd28f192ceb452d1d7ee807c5597b7"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-win_amd64.whl", hash = "sha256:96b02a3dc4381e5494fad39be677abcb5e6634bf7b4fa83a6dd3112607547001"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-macosx_10_9_x86_64.whl", hash = "sha256:95f2a5796329323b8f0512e09dbb7a1860c46a39da62ecb2324f116fa8fdc85c"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:c002b4ffc0be611f0d9da932eb0f704fe2602a9a949d1f738e4c34c75b0863d5"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:a981a536974bbc7a512cf44ed14938cf01030a99e9b3a06dd59578882f06f985"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:3287761bc4ee9e33561a7e058c72ac0938c4f57fe49a09eae428fd88aafe7bb6"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:42cb296636fcc8b0644486d15c12376cb9fa75443e00fb25de0b8602e64c1714"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:0a55554a2fa0d408816b3b5cedf0045f4b8e1a6065aec45849de2d6f3f8e9786"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-musllinux_1_1_aarch64.whl", hash = "sha256:c083af607d2515612056a31f0a8d9e0fcb5876b7bfc0abad3ecd275bc4ebc2d5"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-musllinux_1_1_i686.whl", hash = "sha256:87d1351268731db79e0f8e745d92493ee2841c974128ef629dc518b937d9194c"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-musllinux_1_1_ppc64le.whl", hash = "sha256:bd8f7df7d12c2db9fab40bdd87a7c09b1530128315d047a086fa3ae3435cb3a8"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-musllinux_1_1_s390x.whl", hash = "sha256:c180f51afb394e165eafe4ac2936a14bee3eb10debc9d9e4db8958fe36afe711"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-musllinux_1_1_x86_64.whl", hash = "sha256:8c622a5fe39a48f78944a87d4fb8a53ee07344641b0562c540d840748571b811"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-win32.whl", hash = "sha256:db364eca23f876da6f9e16c9da0df51aa4f104a972735574842618b8c6d999d4"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-win_amd64.whl", hash = "sha256:86216b5cee4b06df986d214f664305142d9c76df9b6512be2738aa72a2048f99"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-macosx_10_9_universal2.whl", hash = "sha256:6463effa3186ea09411d50efc7d85360b38d5f09b870c48e4600f63af490e56a"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-macosx_10_9_x86_64.whl", hash = "sha256:6c4caeef8fa63d06bd437cd4bdcf3ffefe6738fb1b25951440d80dc7df8c03ac"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-macosx_11_0_arm64.whl", hash = "sha256:37e55c8e51c236f95b033f6fb391d7d7970ba5fe7ff453dad675e88cf303377a"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:fb69256e180cb6c8a894fee62b3afebae785babc1ee98b81cdf68bbca1987f33"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:ae5f4161f18c61806f411a13b0310bea87f987c7d2ecdbdaad0e94eb2e404238"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:b2b0a0c0517616b6869869f8c581d4eb2dd83a4d79e0ebcb7d373ef9956aeb0a"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:45485e01ff4d3630ec0d9617310448a8702f70e9c01906b0d0118bdf9d124cf2"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:eb00ed941194665c332bf8e078baf037d6c35d7c4f3102ea2d4f16ca94a26dc8"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-musllinux_1_1_aarch64.whl", hash = "sha256:2127566c664442652f024c837091890cb1942c30937add288223dc895793f898"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-musllinux_1_1_i686.whl", hash = "sha256:a50aebfa173e157099939b17f18600f72f84eed3049e743b68ad15bd69b6bf99"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-musllinux_1_1_ppc64le.whl", hash = "sha256:4d0d1650369165a14e14e1e47b372cfcb31d6ab44e6e33cb2d4e57265290044d"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-musllinux_1_1_s390x.whl", hash = "sha256:923c0c831b7cfcb071580d3f46c4baf50f174be571576556269530f4bbd79d04"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-musllinux_1_1_x86_64.whl", hash = "sha256:06a81e93cd441c56a9b65d8e1d043daeb97a3d0856d177d5c90ba85acb3db087"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-win32.whl", hash = "sha256:6ef1d82a3af9d3eecdba2321dc1b3c238245d890843e040e41e470ffa64c3e25"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-win_amd64.whl", hash = "sha256:eb8821e09e916165e160797a6c17edda0679379a4be5c716c260e836e122f54b"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-macosx_10_9_universal2.whl", hash = "sha256:c235ebd9baae02f1b77bcea61bce332cb4331dc3617d254df3323aa01ab47bd4"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-macosx_10_9_x86_64.whl", hash = "sha256:5b4c145409bef602a690e7cfad0a15a55c13320ff7a3ad7ca59c13bb8ba4d45d"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-macosx_11_0_arm64.whl", hash = "sha256:68d1f8a9e9e37c1223b656399be5d6b448dea850bed7d0f87a8311f1ff3dabb0"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:22afcb9f253dac0696b5a4be4a1c0f8762f8239e21b99680099abd9b2b1b2269"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:e27ad930a842b4c5eb8ac0016b0a54f5aebbe679340c26101df33424142c143c"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:1f79682fbe303db92bc2b1136016a38a42e835d932bab5b3b1bfcfbf0640e519"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:b261ccdec7821281dade748d088bb6e9b69e6d15b30652b74cbbac25e280b796"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:122c7fa62b130ed55f8f285bfd56d5f4b4a5b503609d181f9ad85e55c89f4185"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-musllinux_1_1_aarch64.whl", hash = "sha256:d0eccceffcb53201b5bfebb52600a5fb483a20b61da9dbc885f8b103cbe7598c"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-musllinux_1_1_i686.whl", hash = "sha256:9f96df6923e21816da7e0ad3fd47dd8f94b2a5ce594e00677c0013018b813458"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-musllinux_1_1_ppc64le.whl", hash = "sha256:7f04c839ed0b6b98b1a7501a002144b76c18fb1c1850c8b98d458ac269e26ed2"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-musllinux_1_1_s390x.whl", hash = "sha256:34d1c8da1e78d2e001f363791c98a272bb734000fcef47a491c1e3b0505657a8"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-musllinux_1_1_x86_64.whl", hash = "sha256:ff8fa367d09b717b2a17a052544193ad76cd49979c805768879cb63d9ca50561"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-win32.whl", hash = "sha256:aed38f6e4fb3f5d6bf81bfa990a07806be9d83cf7bacef998ab1a9bd660a581f"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-win_amd64.whl", hash = "sha256:b01b88d45a6fcb69667cd6d2f7a9aeb4bf53760d7fc536bf679ec94fe9f3ff3d"}, + {file = "charset_normalizer-3.3.2-py3-none-any.whl", hash = "sha256:3e4d1f6587322d2788836a99c69062fbb091331ec940e02d12d179c1d53e25fc"}, +] + +[[package]] +name = "colorama" +version = "0.4.6" +description = "Cross-platform colored terminal text." +optional = false +python-versions = "!=3.0.*,!=3.1.*,!=3.2.*,!=3.3.*,!=3.4.*,!=3.5.*,!=3.6.*,>=2.7" +files = [ + {file = "colorama-0.4.6-py2.py3-none-any.whl", hash = "sha256:4f1d9991f5acc0ca119f9d443620b77f9d6b33703e51011c16baf57afb285fc6"}, + {file = "colorama-0.4.6.tar.gz", hash = "sha256:08695f5cb7ed6e0531a20572697297273c47b8cae5a63ffc6d6ed5c201be6e44"}, +] + +[[package]] +name = "docutils" +version = "0.19" +description = "Docutils -- Python Documentation Utilities" +optional = false +python-versions = ">=3.7" +files = [ + {file = "docutils-0.19-py3-none-any.whl", hash = "sha256:5e1de4d849fee02c63b040a4a3fd567f4ab104defd8a5511fbbc24a8a017efbc"}, + {file = "docutils-0.19.tar.gz", hash = "sha256:33995a6753c30b7f577febfc2c50411fec6aac7f7ffeb7c4cfe5991072dcf9e6"}, +] + +[[package]] +name = "exceptiongroup" +version = "1.2.1" +description = "Backport of PEP 654 (exception groups)" +optional = false +python-versions = ">=3.7" +files = [ + {file = "exceptiongroup-1.2.1-py3-none-any.whl", hash = "sha256:5258b9ed329c5bbdd31a309f53cbfb0b155341807f6ff7606a1e801a891b29ad"}, + {file = "exceptiongroup-1.2.1.tar.gz", hash = "sha256:a4785e48b045528f5bfe627b6ad554ff32def154f42372786903b7abcfe1aa16"}, +] + +[package.extras] +test = ["pytest (>=6)"] + +[[package]] +name = "fsspec" +version = "2023.12.2" +description = "File-system specification" +optional = false +python-versions = ">=3.8" +files = [ + {file = "fsspec-2023.12.2-py3-none-any.whl", hash = "sha256:d800d87f72189a745fa3d6b033b9dc4a34ad069f60ca60b943a63599f5501960"}, + {file = "fsspec-2023.12.2.tar.gz", hash = "sha256:8548d39e8810b59c38014934f6b31e57f40c1b20f911f4cc2b85389c7e9bf0cb"}, +] + +[package.extras] +abfs = ["adlfs"] +adl = ["adlfs"] +arrow = ["pyarrow (>=1)"] +dask = ["dask", "distributed"] +devel = ["pytest", "pytest-cov"] +dropbox = ["dropbox", "dropboxdrivefs", "requests"] +full = ["adlfs", "aiohttp (!=4.0.0a0,!=4.0.0a1)", "dask", "distributed", "dropbox", "dropboxdrivefs", "fusepy", "gcsfs", "libarchive-c", "ocifs", "panel", "paramiko", "pyarrow (>=1)", "pygit2", "requests", "s3fs", "smbprotocol", "tqdm"] +fuse = ["fusepy"] +gcs = ["gcsfs"] +git = ["pygit2"] +github = ["requests"] +gs = ["gcsfs"] +gui = ["panel"] +hdfs = ["pyarrow (>=1)"] +http = ["aiohttp (!=4.0.0a0,!=4.0.0a1)", "requests"] +libarchive = ["libarchive-c"] +oci = ["ocifs"] +s3 = ["s3fs"] +sftp = ["paramiko"] +smb = ["smbprotocol"] +ssh = ["paramiko"] +tqdm = ["tqdm"] + +[[package]] +name = "gitdb" +version = "4.0.11" +description = "Git Object Database" +optional = false +python-versions = ">=3.7" +files = [ + {file = "gitdb-4.0.11-py3-none-any.whl", hash = "sha256:81a3407ddd2ee8df444cbacea00e2d038e40150acfa3001696fe0dcf1d3adfa4"}, + {file = "gitdb-4.0.11.tar.gz", hash = "sha256:bf5421126136d6d0af55bc1e7c1af1c397a34f5b7bd79e776cd3e89785c2b04b"}, +] + +[package.dependencies] +smmap = ">=3.0.1,<6" + +[[package]] +name = "gitpython" +version = "3.1.43" +description = "GitPython is a Python library used to interact with Git repositories" +optional = false +python-versions = ">=3.7" +files = [ + {file = "GitPython-3.1.43-py3-none-any.whl", hash = "sha256:eec7ec56b92aad751f9912a73404bc02ba212a23adb2c7098ee668417051a1ff"}, + {file = "GitPython-3.1.43.tar.gz", hash = "sha256:35f314a9f878467f5453cc1fee295c3e18e52f1b99f10f6cf5b1682e968a9e7c"}, +] + +[package.dependencies] +gitdb = ">=4.0.1,<5" + +[package.extras] +doc = ["sphinx (==4.3.2)", "sphinx-autodoc-typehints", "sphinx-rtd-theme", "sphinxcontrib-applehelp (>=1.0.2,<=1.0.4)", "sphinxcontrib-devhelp (==1.0.2)", "sphinxcontrib-htmlhelp (>=2.0.0,<=2.0.1)", "sphinxcontrib-qthelp (==1.0.3)", "sphinxcontrib-serializinghtml (==1.1.5)"] +test = ["coverage[toml]", "ddt (>=1.1.1,!=1.4.3)", "mock", "mypy", "pre-commit", "pytest (>=7.3.1)", "pytest-cov", "pytest-instafail", "pytest-mock", "pytest-sugar", "typing-extensions"] + +[[package]] +name = "idna" +version = "3.7" +description = "Internationalized Domain Names in Applications (IDNA)" +optional = false +python-versions = ">=3.5" +files = [ + {file = "idna-3.7-py3-none-any.whl", hash = "sha256:82fee1fc78add43492d3a1898bfa6d8a904cc97d8427f683ed8e798d07761aa0"}, + {file = "idna-3.7.tar.gz", hash = "sha256:028ff3aadf0609c1fd278d8ea3089299412a7a8b9bd005dd08b9f8285bcb5cfc"}, +] + +[[package]] +name = "imagesize" +version = "1.4.1" +description = "Getting image size from png/jpeg/jpeg2000/gif file" +optional = false +python-versions = ">=2.7, !=3.0.*, !=3.1.*, !=3.2.*, !=3.3.*" +files = [ + {file = "imagesize-1.4.1-py2.py3-none-any.whl", hash = "sha256:0d8d18d08f840c19d0ee7ca1fd82490fdc3729b7ac93f49870406ddde8ef8d8b"}, + {file = "imagesize-1.4.1.tar.gz", hash = "sha256:69150444affb9cb0d5cc5a92b3676f0b2fb7cd9ae39e947a5e11a36b4497cd4a"}, +] + +[[package]] +name = "importlib-metadata" +version = "8.0.0" +description = "Read metadata from Python packages" +optional = false +python-versions = ">=3.8" +files = [ + {file = "importlib_metadata-8.0.0-py3-none-any.whl", hash = "sha256:15584cf2b1bf449d98ff8a6ff1abef57bf20f3ac6454f431736cd3e660921b2f"}, + {file = "importlib_metadata-8.0.0.tar.gz", hash = "sha256:188bd24e4c346d3f0a933f275c2fec67050326a856b9a359881d7c2a697e8812"}, +] + +[package.dependencies] +zipp = ">=0.5" + +[package.extras] +doc = ["furo", "jaraco.packaging (>=9.3)", "jaraco.tidelift (>=1.4)", "rst.linker (>=1.9)", "sphinx (>=3.5)", "sphinx-lint"] +perf = ["ipython"] +test = ["flufl.flake8", "importlib-resources (>=1.3)", "jaraco.test (>=5.4)", "packaging", "pyfakefs", "pytest (>=6,!=8.1.*)", "pytest-checkdocs (>=2.4)", "pytest-cov", "pytest-enabler (>=2.2)", "pytest-mypy", "pytest-perf (>=0.9.2)", "pytest-ruff (>=0.2.1)"] + +[[package]] +name = "iniconfig" +version = "2.0.0" +description = "brain-dead simple config-ini parsing" +optional = false +python-versions = ">=3.7" +files = [ + {file = "iniconfig-2.0.0-py3-none-any.whl", hash = "sha256:b6a85871a79d2e3b22d2d1b94ac2824226a63c6b741c88f7ae975f18b6778374"}, + {file = "iniconfig-2.0.0.tar.gz", hash = "sha256:2d91e135bf72d31a410b17c16da610a82cb55f6b0477d1a902134b24a455b8b3"}, +] + +[[package]] +name = "jinja2" +version = "3.1.4" +description = "A very fast and expressive template engine." +optional = false +python-versions = ">=3.7" +files = [ + {file = "jinja2-3.1.4-py3-none-any.whl", hash = "sha256:bc5dd2abb727a5319567b7a813e6a2e7318c39f4f487cfe6c89c6f9c7d25197d"}, + {file = "jinja2-3.1.4.tar.gz", hash = "sha256:4a3aee7acbbe7303aede8e9648d13b8bf88a429282aa6122a993f0ac800cb369"}, +] + +[package.dependencies] +MarkupSafe = ">=2.0" + +[package.extras] +i18n = ["Babel (>=2.7)"] + +[[package]] +name = "markupsafe" +version = "2.1.5" +description = "Safely add untrusted strings to HTML/XML markup." +optional = false +python-versions = ">=3.7" +files = [ + {file = "MarkupSafe-2.1.5-cp310-cp310-macosx_10_9_universal2.whl", hash = "sha256:a17a92de5231666cfbe003f0e4b9b3a7ae3afb1ec2845aadc2bacc93ff85febc"}, + {file = "MarkupSafe-2.1.5-cp310-cp310-macosx_10_9_x86_64.whl", hash = "sha256:72b6be590cc35924b02c78ef34b467da4ba07e4e0f0454a2c5907f473fc50ce5"}, + {file = "MarkupSafe-2.1.5-cp310-cp310-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:e61659ba32cf2cf1481e575d0462554625196a1f2fc06a1c777d3f48e8865d46"}, + {file = "MarkupSafe-2.1.5-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:2174c595a0d73a3080ca3257b40096db99799265e1c27cc5a610743acd86d62f"}, + {file = "MarkupSafe-2.1.5-cp310-cp310-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:ae2ad8ae6ebee9d2d94b17fb62763125f3f374c25618198f40cbb8b525411900"}, + {file = "MarkupSafe-2.1.5-cp310-cp310-musllinux_1_1_aarch64.whl", hash = "sha256:075202fa5b72c86ad32dc7d0b56024ebdbcf2048c0ba09f1cde31bfdd57bcfff"}, + {file = "MarkupSafe-2.1.5-cp310-cp310-musllinux_1_1_i686.whl", hash = "sha256:598e3276b64aff0e7b3451b72e94fa3c238d452e7ddcd893c3ab324717456bad"}, + {file = "MarkupSafe-2.1.5-cp310-cp310-musllinux_1_1_x86_64.whl", hash = "sha256:fce659a462a1be54d2ffcacea5e3ba2d74daa74f30f5f143fe0c58636e355fdd"}, + {file = "MarkupSafe-2.1.5-cp310-cp310-win32.whl", hash = "sha256:d9fad5155d72433c921b782e58892377c44bd6252b5af2f67f16b194987338a4"}, + {file = "MarkupSafe-2.1.5-cp310-cp310-win_amd64.whl", hash = "sha256:bf50cd79a75d181c9181df03572cdce0fbb75cc353bc350712073108cba98de5"}, + {file = "MarkupSafe-2.1.5-cp311-cp311-macosx_10_9_universal2.whl", hash = "sha256:629ddd2ca402ae6dbedfceeba9c46d5f7b2a61d9749597d4307f943ef198fc1f"}, + {file = "MarkupSafe-2.1.5-cp311-cp311-macosx_10_9_x86_64.whl", hash = "sha256:5b7b716f97b52c5a14bffdf688f971b2d5ef4029127f1ad7a513973cfd818df2"}, + {file = "MarkupSafe-2.1.5-cp311-cp311-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:6ec585f69cec0aa07d945b20805be741395e28ac1627333b1c5b0105962ffced"}, + {file = "MarkupSafe-2.1.5-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:b91c037585eba9095565a3556f611e3cbfaa42ca1e865f7b8015fe5c7336d5a5"}, + {file = "MarkupSafe-2.1.5-cp311-cp311-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:7502934a33b54030eaf1194c21c692a534196063db72176b0c4028e140f8f32c"}, + {file = "MarkupSafe-2.1.5-cp311-cp311-musllinux_1_1_aarch64.whl", hash = "sha256:0e397ac966fdf721b2c528cf028494e86172b4feba51d65f81ffd65c63798f3f"}, + {file = "MarkupSafe-2.1.5-cp311-cp311-musllinux_1_1_i686.whl", hash = "sha256:c061bb86a71b42465156a3ee7bd58c8c2ceacdbeb95d05a99893e08b8467359a"}, + {file = "MarkupSafe-2.1.5-cp311-cp311-musllinux_1_1_x86_64.whl", hash = "sha256:3a57fdd7ce31c7ff06cdfbf31dafa96cc533c21e443d57f5b1ecc6cdc668ec7f"}, + {file = "MarkupSafe-2.1.5-cp311-cp311-win32.whl", hash = "sha256:397081c1a0bfb5124355710fe79478cdbeb39626492b15d399526ae53422b906"}, + {file = "MarkupSafe-2.1.5-cp311-cp311-win_amd64.whl", hash = "sha256:2b7c57a4dfc4f16f7142221afe5ba4e093e09e728ca65c51f5620c9aaeb9a617"}, + {file = "MarkupSafe-2.1.5-cp312-cp312-macosx_10_9_universal2.whl", hash = "sha256:8dec4936e9c3100156f8a2dc89c4b88d5c435175ff03413b443469c7c8c5f4d1"}, + {file = "MarkupSafe-2.1.5-cp312-cp312-macosx_10_9_x86_64.whl", hash = "sha256:3c6b973f22eb18a789b1460b4b91bf04ae3f0c4234a0a6aa6b0a92f6f7b951d4"}, + {file = "MarkupSafe-2.1.5-cp312-cp312-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:ac07bad82163452a6884fe8fa0963fb98c2346ba78d779ec06bd7a6262132aee"}, + {file = "MarkupSafe-2.1.5-cp312-cp312-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:f5dfb42c4604dddc8e4305050aa6deb084540643ed5804d7455b5df8fe16f5e5"}, + {file = "MarkupSafe-2.1.5-cp312-cp312-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:ea3d8a3d18833cf4304cd2fc9cbb1efe188ca9b5efef2bdac7adc20594a0e46b"}, + {file = "MarkupSafe-2.1.5-cp312-cp312-musllinux_1_1_aarch64.whl", hash = "sha256:d050b3361367a06d752db6ead6e7edeb0009be66bc3bae0ee9d97fb326badc2a"}, + {file = "MarkupSafe-2.1.5-cp312-cp312-musllinux_1_1_i686.whl", hash = "sha256:bec0a414d016ac1a18862a519e54b2fd0fc8bbfd6890376898a6c0891dd82e9f"}, + {file = "MarkupSafe-2.1.5-cp312-cp312-musllinux_1_1_x86_64.whl", hash = "sha256:58c98fee265677f63a4385256a6d7683ab1832f3ddd1e66fe948d5880c21a169"}, + {file = "MarkupSafe-2.1.5-cp312-cp312-win32.whl", hash = "sha256:8590b4ae07a35970728874632fed7bd57b26b0102df2d2b233b6d9d82f6c62ad"}, + {file = "MarkupSafe-2.1.5-cp312-cp312-win_amd64.whl", hash = "sha256:823b65d8706e32ad2df51ed89496147a42a2a6e01c13cfb6ffb8b1e92bc910bb"}, + {file = "MarkupSafe-2.1.5-cp37-cp37m-macosx_10_9_x86_64.whl", hash = "sha256:c8b29db45f8fe46ad280a7294f5c3ec36dbac9491f2d1c17345be8e69cc5928f"}, + {file = "MarkupSafe-2.1.5-cp37-cp37m-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:ec6a563cff360b50eed26f13adc43e61bc0c04d94b8be985e6fb24b81f6dcfdf"}, + {file = "MarkupSafe-2.1.5-cp37-cp37m-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:a549b9c31bec33820e885335b451286e2969a2d9e24879f83fe904a5ce59d70a"}, + {file = "MarkupSafe-2.1.5-cp37-cp37m-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:4f11aa001c540f62c6166c7726f71f7573b52c68c31f014c25cc7901deea0b52"}, + {file = "MarkupSafe-2.1.5-cp37-cp37m-musllinux_1_1_aarch64.whl", hash = "sha256:7b2e5a267c855eea6b4283940daa6e88a285f5f2a67f2220203786dfa59b37e9"}, + {file = "MarkupSafe-2.1.5-cp37-cp37m-musllinux_1_1_i686.whl", hash = "sha256:2d2d793e36e230fd32babe143b04cec8a8b3eb8a3122d2aceb4a371e6b09b8df"}, + {file = "MarkupSafe-2.1.5-cp37-cp37m-musllinux_1_1_x86_64.whl", hash = "sha256:ce409136744f6521e39fd8e2a24c53fa18ad67aa5bc7c2cf83645cce5b5c4e50"}, + {file = "MarkupSafe-2.1.5-cp37-cp37m-win32.whl", hash = "sha256:4096e9de5c6fdf43fb4f04c26fb114f61ef0bf2e5604b6ee3019d51b69e8c371"}, + {file = "MarkupSafe-2.1.5-cp37-cp37m-win_amd64.whl", hash = "sha256:4275d846e41ecefa46e2015117a9f491e57a71ddd59bbead77e904dc02b1bed2"}, + {file = "MarkupSafe-2.1.5-cp38-cp38-macosx_10_9_universal2.whl", hash = "sha256:656f7526c69fac7f600bd1f400991cc282b417d17539a1b228617081106feb4a"}, + {file = "MarkupSafe-2.1.5-cp38-cp38-macosx_10_9_x86_64.whl", hash = "sha256:97cafb1f3cbcd3fd2b6fbfb99ae11cdb14deea0736fc2b0952ee177f2b813a46"}, + {file = "MarkupSafe-2.1.5-cp38-cp38-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:1f3fbcb7ef1f16e48246f704ab79d79da8a46891e2da03f8783a5b6fa41a9532"}, + {file = "MarkupSafe-2.1.5-cp38-cp38-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:fa9db3f79de01457b03d4f01b34cf91bc0048eb2c3846ff26f66687c2f6d16ab"}, + {file = "MarkupSafe-2.1.5-cp38-cp38-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:ffee1f21e5ef0d712f9033568f8344d5da8cc2869dbd08d87c84656e6a2d2f68"}, + {file = "MarkupSafe-2.1.5-cp38-cp38-musllinux_1_1_aarch64.whl", hash = "sha256:5dedb4db619ba5a2787a94d877bc8ffc0566f92a01c0ef214865e54ecc9ee5e0"}, + {file = "MarkupSafe-2.1.5-cp38-cp38-musllinux_1_1_i686.whl", hash = "sha256:30b600cf0a7ac9234b2638fbc0fb6158ba5bdcdf46aeb631ead21248b9affbc4"}, + {file = "MarkupSafe-2.1.5-cp38-cp38-musllinux_1_1_x86_64.whl", hash = "sha256:8dd717634f5a044f860435c1d8c16a270ddf0ef8588d4887037c5028b859b0c3"}, + {file = "MarkupSafe-2.1.5-cp38-cp38-win32.whl", hash = "sha256:daa4ee5a243f0f20d528d939d06670a298dd39b1ad5f8a72a4275124a7819eff"}, + {file = "MarkupSafe-2.1.5-cp38-cp38-win_amd64.whl", hash = "sha256:619bc166c4f2de5caa5a633b8b7326fbe98e0ccbfacabd87268a2b15ff73a029"}, + {file = "MarkupSafe-2.1.5-cp39-cp39-macosx_10_9_universal2.whl", hash = "sha256:7a68b554d356a91cce1236aa7682dc01df0edba8d043fd1ce607c49dd3c1edcf"}, + {file = "MarkupSafe-2.1.5-cp39-cp39-macosx_10_9_x86_64.whl", hash = "sha256:db0b55e0f3cc0be60c1f19efdde9a637c32740486004f20d1cff53c3c0ece4d2"}, + {file = "MarkupSafe-2.1.5-cp39-cp39-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:3e53af139f8579a6d5f7b76549125f0d94d7e630761a2111bc431fd820e163b8"}, + {file = "MarkupSafe-2.1.5-cp39-cp39-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:17b950fccb810b3293638215058e432159d2b71005c74371d784862b7e4683f3"}, + {file = "MarkupSafe-2.1.5-cp39-cp39-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:4c31f53cdae6ecfa91a77820e8b151dba54ab528ba65dfd235c80b086d68a465"}, + {file = "MarkupSafe-2.1.5-cp39-cp39-musllinux_1_1_aarch64.whl", hash = "sha256:bff1b4290a66b490a2f4719358c0cdcd9bafb6b8f061e45c7a2460866bf50c2e"}, + {file = "MarkupSafe-2.1.5-cp39-cp39-musllinux_1_1_i686.whl", hash = "sha256:bc1667f8b83f48511b94671e0e441401371dfd0f0a795c7daa4a3cd1dde55bea"}, + {file = "MarkupSafe-2.1.5-cp39-cp39-musllinux_1_1_x86_64.whl", hash = "sha256:5049256f536511ee3f7e1b3f87d1d1209d327e818e6ae1365e8653d7e3abb6a6"}, + {file = "MarkupSafe-2.1.5-cp39-cp39-win32.whl", hash = "sha256:00e046b6dd71aa03a41079792f8473dc494d564611a8f89bbbd7cb93295ebdcf"}, + {file = "MarkupSafe-2.1.5-cp39-cp39-win_amd64.whl", hash = "sha256:fa173ec60341d6bb97a89f5ea19c85c5643c1e7dedebc22f5181eb73573142c5"}, + {file = "MarkupSafe-2.1.5.tar.gz", hash = "sha256:d283d37a890ba4c1ae73ffadf8046435c76e7bc2247bbb63c00bd1a709c6544b"}, +] + +[[package]] +name = "packaging" +version = "24.1" +description = "Core utilities for Python packages" +optional = false +python-versions = ">=3.8" +files = [ + {file = "packaging-24.1-py3-none-any.whl", hash = "sha256:5b8f2217dbdbd2f7f384c41c628544e6d52f2d0f53c6d0c3ea61aa5d1d7ff124"}, + {file = "packaging-24.1.tar.gz", hash = "sha256:026ed72c8ed3fcce5bf8950572258698927fd1dbda10a5e981cdf0ac37f4f002"}, +] + +[[package]] +name = "pluggy" +version = "1.5.0" +description = "plugin and hook calling mechanisms for python" +optional = false +python-versions = ">=3.8" +files = [ + {file = "pluggy-1.5.0-py3-none-any.whl", hash = "sha256:44e1ad92c8ca002de6377e165f3e0f1be63266ab4d554740532335b9d75ea669"}, + {file = "pluggy-1.5.0.tar.gz", hash = "sha256:2cffa88e94fdc978c4c574f15f9e59b7f4201d439195c3715ca9e2486f1d0cf1"}, +] + +[package.extras] +dev = ["pre-commit", "tox"] +testing = ["pytest", "pytest-benchmark"] + +[[package]] +name = "pyfakefs" +version = "5.5.0" +description = "pyfakefs implements a fake file system that mocks the Python file system modules." +optional = false +python-versions = ">=3.7" +files = [ + {file = "pyfakefs-5.5.0-py3-none-any.whl", hash = "sha256:8dbf203ab7bef1529f11f7d41b9478b898e95bf9f3b71262163aac07a518cd76"}, + {file = "pyfakefs-5.5.0.tar.gz", hash = "sha256:7448aaa07142f892d0a4eb52a5ed3206a9f02c6599e686cd97d624c18979c154"}, +] + +[[package]] +name = "pygments" +version = "2.18.0" +description = "Pygments is a syntax highlighting package written in Python." +optional = false +python-versions = ">=3.8" +files = [ + {file = "pygments-2.18.0-py3-none-any.whl", hash = "sha256:b8e6aca0523f3ab76fee51799c488e38782ac06eafcf95e7ba832985c8e7b13a"}, + {file = "pygments-2.18.0.tar.gz", hash = "sha256:786ff802f32e91311bff3889f6e9a86e81505fe99f2735bb6d60ae0c5004f199"}, +] + +[package.extras] +windows-terminal = ["colorama (>=0.4.6)"] + +[[package]] +name = "pytest" +version = "8.2.2" +description = "pytest: simple powerful testing with Python" +optional = false +python-versions = ">=3.8" +files = [ + {file = "pytest-8.2.2-py3-none-any.whl", hash = "sha256:c434598117762e2bd304e526244f67bf66bbd7b5d6cf22138be51ff661980343"}, + {file = "pytest-8.2.2.tar.gz", hash = "sha256:de4bb8104e201939ccdc688b27a89a7be2079b22e2bd2b07f806b6ba71117977"}, +] + +[package.dependencies] +colorama = {version = "*", markers = "sys_platform == \"win32\""} +exceptiongroup = {version = ">=1.0.0rc8", markers = "python_version < \"3.11\""} +iniconfig = "*" +packaging = "*" +pluggy = ">=1.5,<2.0" +tomli = {version = ">=1", markers = "python_version < \"3.11\""} + +[package.extras] +dev = ["argcomplete", "attrs (>=19.2)", "hypothesis (>=3.56)", "mock", "pygments (>=2.7.2)", "requests", "setuptools", "xmlschema"] + +[[package]] +name = "pytz" +version = "2024.1" +description = "World timezone definitions, modern and historical" +optional = false +python-versions = "*" +files = [ + {file = "pytz-2024.1-py2.py3-none-any.whl", hash = "sha256:328171f4e3623139da4983451950b28e95ac706e13f3f2630a879749e7a8b319"}, + {file = "pytz-2024.1.tar.gz", hash = "sha256:2a29735ea9c18baf14b448846bde5a48030ed267578472d8955cd0e7443a9812"}, +] + +[[package]] +name = "requests" +version = "2.32.3" +description = "Python HTTP for Humans." +optional = false +python-versions = ">=3.8" +files = [ + {file = "requests-2.32.3-py3-none-any.whl", hash = "sha256:70761cfe03c773ceb22aa2f671b4757976145175cdfca038c02654d061d6dcc6"}, + {file = "requests-2.32.3.tar.gz", hash = "sha256:55365417734eb18255590a9ff9eb97e9e1da868d4ccd6402399eaf68af20a760"}, +] + +[package.dependencies] +certifi = ">=2017.4.17" +charset-normalizer = ">=2,<4" +idna = ">=2.5,<4" +urllib3 = ">=1.21.1,<3" + +[package.extras] +socks = ["PySocks (>=1.5.6,!=1.5.7)"] +use-chardet-on-py3 = ["chardet (>=3.0.2,<6)"] + +[[package]] +name = "smmap" +version = "5.0.1" +description = "A pure Python implementation of a sliding window memory map manager" +optional = false +python-versions = ">=3.7" +files = [ + {file = "smmap-5.0.1-py3-none-any.whl", hash = "sha256:e6d8668fa5f93e706934a62d7b4db19c8d9eb8cf2adbb75ef1b675aa332b69da"}, + {file = "smmap-5.0.1.tar.gz", hash = "sha256:dceeb6c0028fdb6734471eb07c0cd2aae706ccaecab45965ee83f11c8d3b1f62"}, +] + +[[package]] +name = "snowballstemmer" +version = "2.2.0" +description = "This package provides 29 stemmers for 28 languages generated from Snowball algorithms." +optional = false +python-versions = "*" +files = [ + {file = "snowballstemmer-2.2.0-py2.py3-none-any.whl", hash = "sha256:c8e1716e83cc398ae16824e5572ae04e0d9fc2c6b985fb0f900f5f0c96ecba1a"}, + {file = "snowballstemmer-2.2.0.tar.gz", hash = "sha256:09b16deb8547d3412ad7b590689584cd0fe25ec8db3be37788be3810cbf19cb1"}, +] + +[[package]] +name = "sphinx" +version = "5.3.0" +description = "Python documentation generator" +optional = false +python-versions = ">=3.6" +files = [ + {file = "Sphinx-5.3.0.tar.gz", hash = "sha256:51026de0a9ff9fc13c05d74913ad66047e104f56a129ff73e174eb5c3ee794b5"}, + {file = "sphinx-5.3.0-py3-none-any.whl", hash = "sha256:060ca5c9f7ba57a08a1219e547b269fadf125ae25b06b9fa7f66768efb652d6d"}, +] + +[package.dependencies] +alabaster = ">=0.7,<0.8" +babel = ">=2.9" +colorama = {version = ">=0.4.5", markers = "sys_platform == \"win32\""} +docutils = ">=0.14,<0.20" +imagesize = ">=1.3" +importlib-metadata = {version = ">=4.8", markers = "python_version < \"3.10\""} +Jinja2 = ">=3.0" +packaging = ">=21.0" +Pygments = ">=2.12" +requests = ">=2.5.0" +snowballstemmer = ">=2.0" +sphinxcontrib-applehelp = "*" +sphinxcontrib-devhelp = "*" +sphinxcontrib-htmlhelp = ">=2.0.0" +sphinxcontrib-jsmath = "*" +sphinxcontrib-qthelp = "*" +sphinxcontrib-serializinghtml = ">=1.1.5" + +[package.extras] +docs = ["sphinxcontrib-websupport"] +lint = ["docutils-stubs", "flake8 (>=3.5.0)", "flake8-bugbear", "flake8-comprehensions", "flake8-simplify", "isort", "mypy (>=0.981)", "sphinx-lint", "types-requests", "types-typed-ast"] +test = ["cython", "html5lib", "pytest (>=4.6)", "typed_ast"] + +[[package]] +name = "sphinxcontrib-applehelp" +version = "1.0.4" +description = "sphinxcontrib-applehelp is a Sphinx extension which outputs Apple help books" +optional = false +python-versions = ">=3.8" +files = [ + {file = "sphinxcontrib-applehelp-1.0.4.tar.gz", hash = "sha256:828f867945bbe39817c210a1abfd1bc4895c8b73fcaade56d45357a348a07d7e"}, + {file = "sphinxcontrib_applehelp-1.0.4-py3-none-any.whl", hash = "sha256:29d341f67fb0f6f586b23ad80e072c8e6ad0b48417db2bde114a4c9746feb228"}, +] + +[package.extras] +lint = ["docutils-stubs", "flake8", "mypy"] +test = ["pytest"] + +[[package]] +name = "sphinxcontrib-devhelp" +version = "1.0.2" +description = "sphinxcontrib-devhelp is a sphinx extension which outputs Devhelp document." +optional = false +python-versions = ">=3.5" +files = [ + {file = "sphinxcontrib-devhelp-1.0.2.tar.gz", hash = "sha256:ff7f1afa7b9642e7060379360a67e9c41e8f3121f2ce9164266f61b9f4b338e4"}, + {file = "sphinxcontrib_devhelp-1.0.2-py2.py3-none-any.whl", hash = "sha256:8165223f9a335cc1af7ffe1ed31d2871f325254c0423bc0c4c7cd1c1e4734a2e"}, +] + +[package.extras] +lint = ["docutils-stubs", "flake8", "mypy"] +test = ["pytest"] + +[[package]] +name = "sphinxcontrib-htmlhelp" +version = "2.0.1" +description = "sphinxcontrib-htmlhelp is a sphinx extension which renders HTML help files" +optional = false +python-versions = ">=3.8" +files = [ + {file = "sphinxcontrib-htmlhelp-2.0.1.tar.gz", hash = "sha256:0cbdd302815330058422b98a113195c9249825d681e18f11e8b1f78a2f11efff"}, + {file = "sphinxcontrib_htmlhelp-2.0.1-py3-none-any.whl", hash = "sha256:c38cb46dccf316c79de6e5515e1770414b797162b23cd3d06e67020e1d2a6903"}, +] + +[package.extras] +lint = ["docutils-stubs", "flake8", "mypy"] +test = ["html5lib", "pytest"] + +[[package]] +name = "sphinxcontrib-jsmath" +version = "1.0.1" +description = "A sphinx extension which renders display math in HTML via JavaScript" +optional = false +python-versions = ">=3.5" +files = [ + {file = "sphinxcontrib-jsmath-1.0.1.tar.gz", hash = "sha256:a9925e4a4587247ed2191a22df5f6970656cb8ca2bd6284309578f2153e0c4b8"}, + {file = "sphinxcontrib_jsmath-1.0.1-py2.py3-none-any.whl", hash = "sha256:2ec2eaebfb78f3f2078e73666b1415417a116cc848b72e5172e596c871103178"}, +] + +[package.extras] +test = ["flake8", "mypy", "pytest"] + +[[package]] +name = "sphinxcontrib-qthelp" +version = "1.0.3" +description = "sphinxcontrib-qthelp is a sphinx extension which outputs QtHelp document." +optional = false +python-versions = ">=3.5" +files = [ + {file = "sphinxcontrib-qthelp-1.0.3.tar.gz", hash = "sha256:4c33767ee058b70dba89a6fc5c1892c0d57a54be67ddd3e7875a18d14cba5a72"}, + {file = "sphinxcontrib_qthelp-1.0.3-py2.py3-none-any.whl", hash = "sha256:bd9fc24bcb748a8d51fd4ecaade681350aa63009a347a8c14e637895444dfab6"}, +] + +[package.extras] +lint = ["docutils-stubs", "flake8", "mypy"] +test = ["pytest"] + +[[package]] +name = "sphinxcontrib-serializinghtml" +version = "1.1.5" +description = "sphinxcontrib-serializinghtml is a sphinx extension which outputs \"serialized\" HTML files (json and pickle)." +optional = false +python-versions = ">=3.5" +files = [ + {file = "sphinxcontrib-serializinghtml-1.1.5.tar.gz", hash = "sha256:aa5f6de5dfdf809ef505c4895e51ef5c9eac17d0f287933eb49ec495280b6952"}, + {file = "sphinxcontrib_serializinghtml-1.1.5-py2.py3-none-any.whl", hash = "sha256:352a9a00ae864471d3a7ead8d7d79f5fc0b57e8b3f95e9867eb9eb28999b92fd"}, +] + +[package.extras] +lint = ["docutils-stubs", "flake8", "mypy"] +test = ["pytest"] + +[[package]] +name = "tomli" +version = "2.0.1" +description = "A lil' TOML parser" +optional = false +python-versions = ">=3.7" +files = [ + {file = "tomli-2.0.1-py3-none-any.whl", hash = "sha256:939de3e7a6161af0c887ef91b7d41a53e7c5a1ca976325f429cb46ea9bc30ecc"}, + {file = "tomli-2.0.1.tar.gz", hash = "sha256:de526c12914f0c550d15924c62d72abc48d6fe7364aa87328337a31007fe8a4f"}, +] + +[[package]] +name = "urllib3" +version = "2.2.2" +description = "HTTP library with thread-safe connection pooling, file post, and more." +optional = false +python-versions = ">=3.8" +files = [ + {file = "urllib3-2.2.2-py3-none-any.whl", hash = "sha256:a448b2f64d686155468037e1ace9f2d2199776e17f0a46610480d311f73e3472"}, + {file = "urllib3-2.2.2.tar.gz", hash = "sha256:dd505485549a7a552833da5e6063639d0d177c04f23bc3864e41e5dc5f612168"}, +] + +[package.extras] +brotli = ["brotli (>=1.0.9)", "brotlicffi (>=0.8.0)"] +h2 = ["h2 (>=4,<5)"] +socks = ["pysocks (>=1.5.6,!=1.5.7,<2.0)"] +zstd = ["zstandard (>=0.18.0)"] + +[[package]] +name = "wheel" +version = "0.42.0" +description = "A built-package format for Python" +optional = false +python-versions = ">=3.7" +files = [ + {file = "wheel-0.42.0-py3-none-any.whl", hash = "sha256:177f9c9b0d45c47873b619f5b650346d632cdc35fb5e4d25058e09c9e581433d"}, + {file = "wheel-0.42.0.tar.gz", hash = "sha256:c45be39f7882c9d34243236f2d63cbd58039e360f85d0913425fbd7ceea617a8"}, +] + +[package.extras] +test = ["pytest (>=6.0.0)", "setuptools (>=65)"] + +[[package]] +name = "zipp" +version = "3.19.2" +description = "Backport of pathlib-compatible object wrapper for zip files" +optional = false +python-versions = ">=3.8" +files = [ + {file = "zipp-3.19.2-py3-none-any.whl", hash = "sha256:f091755f667055f2d02b32c53771a7a6c8b47e1fdbc4b72a8b9072b3eef8015c"}, + {file = "zipp-3.19.2.tar.gz", hash = "sha256:bf1dcf6450f873a13e952a29504887c89e6de7506209e5b1bcc3460135d4de19"}, +] + +[package.extras] +doc = ["furo", "jaraco.packaging (>=9.3)", "jaraco.tidelift (>=1.4)", "rst.linker (>=1.9)", "sphinx (>=3.5)", "sphinx-lint"] +test = ["big-O", "importlib-resources", "jaraco.functools", "jaraco.itertools", "jaraco.test", "more-itertools", "pytest (>=6,!=8.1.*)", "pytest-checkdocs (>=2.4)", "pytest-cov", "pytest-enabler (>=2.2)", "pytest-ignore-flaky", "pytest-mypy", "pytest-ruff (>=0.2.1)"] + +[metadata] +lock-version = "2.0" +python-versions = "^3.8" +content-hash = "25ee2ae1d74abedde3a6637a60d4a3095ea5cf9731960875741bbc2ba84a475d" diff --git a/.lib/git-fleximod/pyproject.toml b/.lib/git-fleximod/pyproject.toml new file mode 100644 index 0000000000..850e57d59d --- /dev/null +++ b/.lib/git-fleximod/pyproject.toml @@ -0,0 +1,41 @@ +[tool.poetry] +name = "git-fleximod" +version = "0.8.4" +description = "Extended support for git-submodule and git-sparse-checkout" +authors = ["Jim Edwards "] +maintainers = ["Jim Edwards "] +license = "MIT" +readme = "README.md" +homepage = "https://github.com/jedwards4b/git-fleximod" +keywords = ["git", "submodule", "sparse-checkout"] +packages = [ +{ include = "git_fleximod"}, +{ include = "doc"}, +] + +[tool.poetry.scripts] +git-fleximod = "git_fleximod.git_fleximod:main" +me2flexi = "git_fleximod.metoflexi:_main" +fsspec = "fsspec.fuse:main" + +[tool.poetry.dependencies] +python = "^3.8" +GitPython = "^3.1.0" +sphinx = "^5.0.0" +fsspec = "^2023.12.2" +wheel = "^0.42.0" +pytest = "^8.0.0" +pyfakefs = "^5.3.5" + +[tool.poetry.urls] +"Bug Tracker" = "https://github.com/jedwards4b/git-fleximod/issues" + +[tool.pytest.ini_options] +markers = [ + "skip_after_first: only run on first iteration" +] + +[build-system] +requires = ["poetry-core"] +build-backend = "poetry.core.masonry.api" + diff --git a/.lib/git-fleximod/tbump.toml b/.lib/git-fleximod/tbump.toml new file mode 100644 index 0000000000..bd82c557ad --- /dev/null +++ b/.lib/git-fleximod/tbump.toml @@ -0,0 +1,43 @@ +# Uncomment this if your project is hosted on GitHub: +github_url = "https://github.com/jedwards4b/git-fleximod/" + +[version] +current = "0.8.4" + +# Example of a semver regexp. +# Make sure this matches current_version before +# using tbump +regex = ''' + (?P\d+) + \. + (?P\d+) + \. + (?P\d+) + ''' + +[git] +message_template = "Bump to {new_version}" +tag_template = "v{new_version}" + +# For each file to patch, add a [[file]] config +# section containing the path of the file, relative to the +# tbump.toml location. +[[file]] +src = "git_fleximod/cli.py" + +[[file]] +src = "pyproject.toml" + +# You can specify a list of commands to +# run after the files have been patched +# and before the git commit is made + +# [[before_commit]] +# name = "check changelog" +# cmd = "grep -q {new_version} Changelog.rst" + +# Or run some commands after the git tag and the branch +# have been pushed: +# [[after_push]] +# name = "publish" +# cmd = "./publish.sh" diff --git a/.lib/git-fleximod/tests/__init__.py b/.lib/git-fleximod/tests/__init__.py new file mode 100644 index 0000000000..4d4c66c78e --- /dev/null +++ b/.lib/git-fleximod/tests/__init__.py @@ -0,0 +1,3 @@ +import sys, os + +sys.path.append(os.path.join(os.path.dirname(__file__), os.path.pardir, "src")) diff --git a/.lib/git-fleximod/tests/conftest.py b/.lib/git-fleximod/tests/conftest.py new file mode 100644 index 0000000000..81edbe713e --- /dev/null +++ b/.lib/git-fleximod/tests/conftest.py @@ -0,0 +1,150 @@ +import pytest +from git_fleximod.gitinterface import GitInterface +import os +import subprocess +import logging +from pathlib import Path + +@pytest.fixture(scope='session') +def logger(): + logging.basicConfig( + level=logging.INFO, format="%(name)s - %(levelname)s - %(message)s", handlers=[logging.StreamHandler()] + ) + logger = logging.getLogger(__name__) + return logger + +all_repos=[ + {"subrepo_path": "modules/test", + "submodule_name": "test_submodule", + "status1" : "test_submodule MPIserial_2.5.0-3-gd82ce7c is out of sync with .gitmodules MPIserial_2.4.0", + "status2" : "test_submodule at tag MPIserial_2.4.0", + "status3" : "test_submodule at tag MPIserial_2.4.0", + "status4" : "test_submodule at tag MPIserial_2.4.0", + "gitmodules_content" : """ + [submodule "test_submodule"] + path = modules/test + url = https://github.com/ESMCI/mpi-serial.git + fxtag = MPIserial_2.4.0 + fxDONOTUSEurl = https://github.com/ESMCI/mpi-serial.git + fxrequired = ToplevelRequired +"""}, + {"subrepo_path": "modules/test_optional", + "submodule_name": "test_optional", + "status1" : "test_optional MPIserial_2.5.0-3-gd82ce7c is out of sync with .gitmodules MPIserial_2.4.0", + "status2" : "test_optional at tag MPIserial_2.4.0", + "status3" : "test_optional not checked out, out of sync at tag None, expected tag is MPIserial_2.4.0 (optional)", + "status4" : "test_optional at tag MPIserial_2.4.0", + "gitmodules_content": """ + [submodule "test_optional"] + path = modules/test_optional + url = https://github.com/ESMCI/mpi-serial.git + fxtag = MPIserial_2.4.0 + fxDONOTUSEurl = https://github.com/ESMCI/mpi-serial.git + fxrequired = ToplevelOptional +"""}, + {"subrepo_path": "modules/test_alwaysoptional", + "submodule_name": "test_alwaysoptional", + "status1" : "test_alwaysoptional MPIserial_2.3.0 is out of sync with .gitmodules e5cf35c", + "status2" : "test_alwaysoptional at hash e5cf35c", + "status3" : "out of sync at tag None, expected tag is e5cf35c", + "status4" : "test_alwaysoptional at hash e5cf35c", + "gitmodules_content": """ + [submodule "test_alwaysoptional"] + path = modules/test_alwaysoptional + url = https://github.com/ESMCI/mpi-serial.git + fxtag = e5cf35c + fxDONOTUSEurl = https://github.com/ESMCI/mpi-serial.git + fxrequired = AlwaysOptional +"""}, + {"subrepo_path": "modules/test_sparse", + "submodule_name": "test_sparse", + "status1" : "test_sparse at tag MPIserial_2.5.0", + "status2" : "test_sparse at tag MPIserial_2.5.0", + "status3" : "test_sparse at tag MPIserial_2.5.0", + "status4" : "test_sparse at tag MPIserial_2.5.0", + "gitmodules_content": """ + [submodule "test_sparse"] + path = modules/test_sparse + url = https://github.com/ESMCI/mpi-serial.git + fxtag = MPIserial_2.5.0 + fxDONOTUSEurl = https://github.com/ESMCI/mpi-serial.git + fxrequired = AlwaysRequired + fxsparse = ../.sparse_file_list +"""}, +] +@pytest.fixture(params=all_repos) + +def shared_repos(request): + return request.param + +@pytest.fixture +def get_all_repos(): + return all_repos + +def write_sparse_checkout_file(fp): + sparse_content = """m4 +""" + fp.write_text(sparse_content) + +@pytest.fixture +def test_repo(shared_repos, tmp_path, logger): + subrepo_path = shared_repos["subrepo_path"] + submodule_name = shared_repos["submodule_name"] + test_dir = tmp_path / "testrepo" + test_dir.mkdir() + str_path = str(test_dir) + gitp = GitInterface(str_path, logger) + assert test_dir.joinpath(".git").is_dir() + (test_dir / "modules").mkdir() + if "sparse" in submodule_name: + (test_dir / subrepo_path).mkdir() + # Add the sparse checkout file + write_sparse_checkout_file(test_dir / "modules" / ".sparse_file_list") + gitp.git_operation("add","modules/.sparse_file_list") + else: + gitp = GitInterface(str(test_dir), logger) + gitp.git_operation("submodule", "add", "--depth","1","--name", submodule_name, "https://github.com/ESMCI/mpi-serial.git", subrepo_path) + assert test_dir.joinpath(".gitmodules").is_file() + gitp.git_operation("add",subrepo_path) + gitp.git_operation("commit","-a","-m","\"add submod\"") + test_dir2 = tmp_path / "testrepo2" + gitp.git_operation("clone",test_dir,test_dir2) + return test_dir2 + + +@pytest.fixture +def complex_repo(tmp_path, logger): + test_dir = tmp_path / "testcomplex" + test_dir.mkdir() + str_path = str(test_dir) + gitp = GitInterface(str_path, logger) + gitp.git_operation("remote", "add", "origin", "https://github.com/jedwards4b/fleximod-test2") + gitp.git_operation("fetch", "origin") + gitp.git_operation("checkout", "v0.0.1") + return test_dir + +@pytest.fixture +def complex_update(tmp_path, logger): + test_dir = tmp_path / "testcomplex" + test_dir.mkdir() + str_path = str(test_dir) + gitp = GitInterface(str_path, logger) + gitp.git_operation("remote", "add", "origin", "https://github.com/jedwards4b/fleximod-test2") + gitp.git_operation("fetch", "origin") + gitp.git_operation("checkout", "v0.0.2") + + return test_dir + +@pytest.fixture +def git_fleximod(): + def _run_fleximod(path, args, input=None): + cmd = ["git", "fleximod"] + args.split() + result = subprocess.run(cmd, cwd=path, input=input, + stdout=subprocess.PIPE, stderr=subprocess.PIPE, + text=True) + if result.returncode: + print(result.stdout) + print(result.stderr) + return result + return _run_fleximod + diff --git a/.lib/git-fleximod/tests/test_a_import.py b/.lib/git-fleximod/tests/test_a_import.py new file mode 100644 index 0000000000..d5ca878de5 --- /dev/null +++ b/.lib/git-fleximod/tests/test_a_import.py @@ -0,0 +1,8 @@ +# pylint: disable=unused-import +from git_fleximod import cli +from git_fleximod import utils +from git_fleximod.gitinterface import GitInterface +from git_fleximod.gitmodules import GitModules + +def test_import(): + print("here") diff --git a/.lib/git-fleximod/tests/test_b_update.py b/.lib/git-fleximod/tests/test_b_update.py new file mode 100644 index 0000000000..159f1cfae0 --- /dev/null +++ b/.lib/git-fleximod/tests/test_b_update.py @@ -0,0 +1,26 @@ +import pytest +from pathlib import Path + +def test_basic_checkout(git_fleximod, test_repo, shared_repos): + # Prepare a simple .gitmodules + gm = shared_repos['gitmodules_content'] + file_path = (test_repo / ".gitmodules") + repo_name = shared_repos["submodule_name"] + repo_path = shared_repos["subrepo_path"] + + file_path.write_text(gm) + + # Run the command + result = git_fleximod(test_repo, f"update {repo_name}") + + # Assertions + assert result.returncode == 0 + assert Path(test_repo / repo_path).exists() # Did the submodule directory get created? + if "sparse" in repo_name: + assert Path(test_repo / f"{repo_path}/m4").exists() # Did the submodule sparse directory get created? + assert not Path(test_repo / f"{repo_path}/README").exists() # Did only the submodule sparse directory get created? + + status = git_fleximod(test_repo, f"status {repo_name}") + + assert shared_repos["status2"] in status.stdout + diff --git a/.lib/git-fleximod/tests/test_c_required.py b/.lib/git-fleximod/tests/test_c_required.py new file mode 100644 index 0000000000..89ab8d294d --- /dev/null +++ b/.lib/git-fleximod/tests/test_c_required.py @@ -0,0 +1,30 @@ +import pytest +from pathlib import Path + +def test_required(git_fleximod, test_repo, shared_repos): + file_path = (test_repo / ".gitmodules") + gm = shared_repos["gitmodules_content"] + repo_name = shared_repos["submodule_name"] + if file_path.exists(): + with file_path.open("r") as f: + gitmodules_content = f.read() + # add the entry if it does not exist + if repo_name not in gitmodules_content: + file_path.write_text(gitmodules_content+gm) + # or if it is incomplete + elif gm not in gitmodules_content: + file_path.write_text(gm) + else: + file_path.write_text(gm) + result = git_fleximod(test_repo, "update") + assert result.returncode == 0 + status = git_fleximod(test_repo, f"status {repo_name}") + assert shared_repos["status3"] in status.stdout + status = git_fleximod(test_repo, f"update --optional") + assert result.returncode == 0 + status = git_fleximod(test_repo, f"status {repo_name}") + assert shared_repos["status4"] in status.stdout + status = git_fleximod(test_repo, f"update {repo_name}") + assert result.returncode == 0 + status = git_fleximod(test_repo, f"status {repo_name}") + assert shared_repos["status4"] in status.stdout diff --git a/.lib/git-fleximod/tests/test_d_complex.py b/.lib/git-fleximod/tests/test_d_complex.py new file mode 100644 index 0000000000..edde7d816d --- /dev/null +++ b/.lib/git-fleximod/tests/test_d_complex.py @@ -0,0 +1,66 @@ +import pytest +from pathlib import Path +from git_fleximod.gitinterface import GitInterface + +def test_complex_checkout(git_fleximod, complex_repo, logger): + status = git_fleximod(complex_repo, "status") + assert("ToplevelOptional not checked out, aligned at tag v5.3.2" in status.stdout) + assert("ToplevelRequired not checked out, aligned at tag MPIserial_2.5.0" in status.stdout) + assert("AlwaysRequired not checked out, aligned at tag MPIserial_2.4.0" in status.stdout) + assert("Complex not checked out, aligned at tag testtag02" in status.stdout) + assert("AlwaysOptional not checked out, out of sync at tag None, expected tag is MPIserial_2.3.0" in status.stdout) + + # This should checkout and update test_submodule and complex_sub + result = git_fleximod(complex_repo, "update") + assert result.returncode == 0 + + status = git_fleximod(complex_repo, "status") + assert("ToplevelOptional not checked out, aligned at tag v5.3.2" in status.stdout) + assert("ToplevelRequired at tag MPIserial_2.5.0" in status.stdout) + assert("AlwaysRequired at tag MPIserial_2.4.0" in status.stdout) + assert("Complex at tag testtag02" in status.stdout) + + # now check the complex_sub + root = (complex_repo / "modules" / "complex") + assert(not (root / "libraries" / "gptl" / ".git").exists()) + assert(not (root / "libraries" / "mpi-serial" / ".git").exists()) + assert((root / "modules" / "mpi-serial" / ".git").exists()) + assert(not (root / "modules" / "mpi-serial2" / ".git").exists()) + assert((root / "modules" / "mpi-sparse" / ".git").exists()) + assert((root / "modules" / "mpi-sparse" / "m4").exists()) + assert(not (root / "modules" / "mpi-sparse" / "README").exists()) + + # update a single optional submodule + + result = git_fleximod(complex_repo, "update ToplevelOptional") + assert result.returncode == 0 + + status = git_fleximod(complex_repo, "status") + assert("ToplevelOptional at tag v5.3.2" in status.stdout) + assert("ToplevelRequired at tag MPIserial_2.5.0" in status.stdout) + assert("AlwaysRequired at tag MPIserial_2.4.0" in status.stdout) + assert("Complex at tag testtag02" in status.stdout) + assert("AlwaysOptional not checked out, out of sync at tag None, expected tag is MPIserial_2.3.0" in status.stdout) + + # Finally update optional + result = git_fleximod(complex_repo, "update --optional") + assert result.returncode == 0 + + status = git_fleximod(complex_repo, "status") + assert("ToplevelOptional at tag v5.3.2" in status.stdout) + assert("ToplevelRequired at tag MPIserial_2.5.0" in status.stdout) + assert("AlwaysRequired at tag MPIserial_2.4.0" in status.stdout) + assert("Complex at tag testtag02" in status.stdout) + assert("AlwaysOptional at tag MPIserial_2.3.0" in status.stdout) + + # now check the complex_sub + root = (complex_repo / "modules" / "complex" ) + assert(not (root / "libraries" / "gptl" / ".git").exists()) + assert(not (root / "libraries" / "mpi-serial" / ".git").exists()) + assert((root / "modules" / "mpi-serial" / ".git").exists()) + assert((root / "modules" / "mpi-serial2" / ".git").exists()) + assert((root / "modules" / "mpi-sparse" / ".git").exists()) + assert((root / "modules" / "mpi-sparse" / "m4").exists()) + assert(not (root / "modules" / "mpi-sparse" / "README").exists()) + + diff --git a/.lib/git-fleximod/tests/test_e_complex_update.py b/.lib/git-fleximod/tests/test_e_complex_update.py new file mode 100644 index 0000000000..0c3ab4c6a6 --- /dev/null +++ b/.lib/git-fleximod/tests/test_e_complex_update.py @@ -0,0 +1,69 @@ +import pytest +from pathlib import Path +from git_fleximod.gitinterface import GitInterface + +def test_complex_update(git_fleximod, complex_update, logger): + status = git_fleximod(complex_update, "status") + assert("ToplevelOptional not checked out, aligned at tag v5.3.2" in status.stdout) + assert("ToplevelRequired not checked out, aligned at tag MPIserial_2.5.0" in status.stdout) + assert("AlwaysRequired not checked out, aligned at tag MPIserial_2.4.0" in status.stdout) + assert("Complex not checked out, out of sync at tag testtag02, expected tag is testtag3" in status.stdout) + assert("AlwaysOptional not checked out, out of sync at tag None, expected tag is MPIserial_2.3.0" in status.stdout) + + # This should checkout and update test_submodule and complex_sub + result = git_fleximod(complex_update, "update") + assert result.returncode == 0 + + status = git_fleximod(complex_update, "status") + assert("ToplevelOptional not checked out, aligned at tag v5.3.2" in status.stdout) + assert("ToplevelRequired at tag MPIserial_2.5.0" in status.stdout) + assert("AlwaysRequired at tag MPIserial_2.4.0" in status.stdout) + assert("Complex at tag testtag3" in status.stdout) + + # now check the complex_sub + root = (complex_update / "modules" / "complex") + assert(not (root / "libraries" / "gptl" / ".git").exists()) + assert(not (root / "libraries" / "mpi-serial" / ".git").exists()) + assert((root / "modules" / "mpi-serialAR" / ".git").exists()) + assert((root / "modules" / "mpi-serialSAR" / ".git").exists()) + assert(not (root / "modules" / "mpi-serial2" / ".git").exists()) + assert((root / "modules" / "mpi-sparse" / ".git").exists()) + assert((root / "modules" / "mpi-sparse" / "m4").exists()) + assert(not (root / "modules" / "mpi-sparse" / "README").exists()) + + # update a single optional submodule + + result = git_fleximod(complex_update, "update ToplevelOptional") + assert result.returncode == 0 + + status = git_fleximod(complex_update, "status") + assert("ToplevelOptional at tag v5.3.2" in status.stdout) + assert("ToplevelRequired at tag MPIserial_2.5.0" in status.stdout) + assert("AlwaysRequired at tag MPIserial_2.4.0" in status.stdout) + assert("Complex at tag testtag3" in status.stdout) + assert("AlwaysOptional not checked out, out of sync at tag None, expected tag is MPIserial_2.3.0" in status.stdout) + + # Finally update optional + result = git_fleximod(complex_update, "update --optional") + assert result.returncode == 0 + + status = git_fleximod(complex_update, "status") + assert("ToplevelOptional at tag v5.3.2" in status.stdout) + assert("ToplevelRequired at tag MPIserial_2.5.0" in status.stdout) + assert("AlwaysRequired at tag MPIserial_2.4.0" in status.stdout) + assert("Complex at tag testtag3" in status.stdout) + assert("AlwaysOptional at tag MPIserial_2.3.0" in status.stdout) + + # now check the complex_sub + root = (complex_update / "modules" / "complex" ) + assert(not (root / "libraries" / "gptl" / ".git").exists()) + assert(not (root / "libraries" / "mpi-serial" / ".git").exists()) + assert(not (root / "modules" / "mpi-serial" / ".git").exists()) + assert((root / "modules" / "mpi-serialAR" / ".git").exists()) + assert((root / "modules" / "mpi-serialSAR" / ".git").exists()) + assert((root / "modules" / "mpi-sparse" / ".git").exists()) + assert((root / "modules" / "mpi-serial2" / ".git").exists()) + assert((root / "modules" / "mpi-sparse" / "m4").exists()) + assert(not (root / "modules" / "mpi-sparse" / "README").exists()) + + diff --git a/Externals.cfg b/Externals.cfg deleted file mode 100644 index dfe04d45c4..0000000000 --- a/Externals.cfg +++ /dev/null @@ -1,119 +0,0 @@ -[ccs_config] -tag = ccs_config_cesm0.0.82 -protocol = git -repo_url = https://github.com/ESMCI/ccs_config_cesm -local_path = ccs_config -required = True - -[cice5] -tag = cice5_20220204 -protocol = git -repo_url = https://github.com/ESCOMP/CESM_CICE5 -local_path = components/cice5 -required = True - -[cice6] -tag = cesm_cice6_4_1_10 -protocol = git -repo_url = https://github.com/ESCOMP/CESM_CICE -local_path = components/cice -externals = Externals.cfg -required = True - -[cmeps] -tag = cmeps0.14.43 -protocol = git -repo_url = https://github.com/ESCOMP/CMEPS.git -local_path = components/cmeps -required = True - -[cdeps] -tag = cdeps1.0.24 -protocol = git -repo_url = https://github.com/ESCOMP/CDEPS.git -local_path = components/cdeps -externals = Externals_CDEPS.cfg -required = True - -[cpl7] -tag = cpl77.0.7 -protocol = git -repo_url = https://github.com/ESCOMP/CESM_CPL7andDataComps -local_path = components/cpl7 -required = True - -[share] -tag = share1.0.17 -protocol = git -repo_url = https://github.com/ESCOMP/CESM_share -local_path = share -required = True - -[mct] -tag = MCT_2.11.0 -protocol = git -repo_url = https://github.com/MCSclimate/MCT -local_path = libraries/mct -required = True - -[parallelio] -tag = pio2_6_2 -protocol = git -repo_url = https://github.com/NCAR/ParallelIO -local_path = libraries/parallelio -required = True - -[cime] -tag = cime6.0.175 -protocol = git -repo_url = https://github.com/ESMCI/cime -local_path = cime -required = True - -[cism] -tag = cismwrap_2_1_96 -protocol = git -repo_url = https://github.com/ESCOMP/CISM-wrapper -local_path = components/cism -externals = Externals_CISM.cfg -required = True - -[clm] -tag = ctsm5.1.dev142 -protocol = git -repo_url = https://github.com/ESCOMP/CTSM -local_path = components/clm -externals = Externals_CLM.cfg -required = True - -[fms] -# Older tag than CESM as there is a compilation error mismatch -tag = fi_20211011 -protocol = git -repo_url = https://github.com/ESCOMP/FMS_interface -local_path = libraries/FMS -externals = Externals_FMS.cfg -required = True - -[mosart] -tag = mosart1_0_48 -protocol = git -repo_url = https://github.com/ESCOMP/MOSART -local_path = components/mosart -required = True - -[rtm] -tag = rtm1_0_78 -protocol = git -repo_url = https://github.com/ESCOMP/RTM -local_path = components/rtm -required = True - -[cam] -local_path = . -protocol = externals_only -externals = Externals_CAM.cfg -required = True - -[externals_description] -schema_version = 1.0.0 diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg deleted file mode 100644 index debf4c613e..0000000000 --- a/Externals_CAM.cfg +++ /dev/null @@ -1,104 +0,0 @@ -[chem_proc] -local_path = chem_proc -protocol = git -repo_url = https://github.com/ESCOMP/CHEM_PREPROCESSOR.git -tag = chem_proc5_0_05 -required = True - -[carma] -local_path = src/physics/carma/base -protocol = git -repo_url = https://github.com/ESCOMP/CARMA_base.git -tag = carma4_01 -required = True - -[cosp2] -local_path = src/physics/cosp2/src -protocol = git -repo_url = https://github.com/CFMIP/COSPv2.0 -sparse = ../.cosp_sparse_checkout -tag = v2.1.4cesm -required = True - -[clubb] -local_path = src/physics/clubb -protocol = git -repo_url = https://github.com/larson-group/clubb_release -sparse = ../.clubb_sparse_checkout -tag = clubb_4ncar_20221129_59cb19f_20230330_branchtag -required = True - -[pumas] -local_path = src/physics/pumas -protocol = git -repo_url = https://github.com/ESCOMP/PUMAS -tag = pumas_cam-release_v1.35 -required = True - -[pumas-frozen] -local_path = src/physics/pumas-frozen -protocol = git -repo_url = https://github.com/ESCOMP/PUMAS -tag = pumas_cam-release_v1.17_rename -required = True - -[ali_arms] -local_path = src/physics/ali_arms -protocol = git -repo_url = https://github.com/ESCOMP/ALI-ARMS -tag = ALI_ARMS_v1.0.1 -required = True - -[atmos_phys] -tag = atmos_phys0_02_000 -protocol = git -repo_url = https://github.com/ESCOMP/atmospheric_physics -required = True -local_path = src/atmos_phys - -[atmos_cubed_sphere] -tag = fv3_cesm.04 -protocol = git -repo_url = https://github.com/ESCOMP/FV3_CESM.git -local_path = src/dynamics/fv3/atmos_cubed_sphere -required = True - -[mpas] -local_path = src/dynamics/mpas/dycore -protocol = git -repo_url = https://github.com/MPAS-Dev/MPAS-Model.git -sparse = ../.mpas_sparse_checkout -hash = b8c33daa -required = True - -[geoschem] -local_path = src/chemistry/geoschem/geoschem_src -protocol = git -repo_url = https://github.com/geoschem/geos-chem.git -tag = 14.1.2 -required = True - -[hemco] -local_path = src/hemco -tag = hemco-cesm1_2_1_hemco3_6_3_cesm -protocol = git -repo_url = https://github.com/ESCOMP/HEMCO_CESM.git -required = True -externals = Externals_HCO.cfg - -[rte-rrtmgp] -local_path = src/physics/rrtmgp/ext -protocol = git -repo_url = https://github.com/earth-system-radiation/rte-rrtmgp.git -tag = v1.7 -required = True - -[rrtmgp-data] -local_path = src/physics/rrtmgp/data -protocol = git -repo_url = https://github.com/earth-system-radiation/rrtmgp-data.git -tag = v1.8 -required = True - -[externals_description] -schema_version = 1.0.0 diff --git a/README.md b/README.md index e03fb36018..a6aa6fee8c 100644 --- a/README.md +++ b/README.md @@ -2,6 +2,20 @@ ## NOTE: This is **unsupported** development code and is subject to the [CESM developer's agreement](http://www.cgd.ucar.edu/cseg/development-code.html). +----------- + +To checkout externals: + bin/git-fleximod update + +The externals are stored in: + .gitmodules + +.gitmodules can be modified. Then run "bin/git-fleximod update" to get the updated externals + +Details about git-fleximod and the variables in the .gitmodules file can be found at: .lib/git-fleximod/README.md + +------------ + ### CAM Documentation - https://ncar.github.io/CAM/doc/build/html/index.html ### CAM6 namelist settings - http://www.cesm.ucar.edu/models/cesm2/settings/current/cam_nml.html diff --git a/README_EXTERNALS b/README_EXTERNALS deleted file mode 100644 index 2b6c2bc4e3..0000000000 --- a/README_EXTERNALS +++ /dev/null @@ -1,49 +0,0 @@ -Example taken from bulletin board forum for "Subversion Issues" in the -thread for "Introduction to Subversion"...(070208) - - -Working with externals: - -checkout the HEAD of cam's trunk into working copy directory -> svn co $SVN/cam1/trunk cam_trunk_head_wc - -view the property set for cam's external definitions -> svn propget svn:externals cam_trunk_head_wc - -view revision, URL and other useful information specific to external files -> cd cam_trunk_head_wc/models/lnd/clm2/src -> svn info main - -create new clm branch for mods required of cam -> svn copy $SVN/clm2/trunk_tags/ $SVN/clm2/branches/ -m "appropriate message" - -have external directories in working copy refer to new clm branch to make changes -> svn switch $SVN/clm2/branches//src/main main - ---make changes to clm files-- - -when satisfied with changes and testing, commit to HEAD of clm branch -> svn commit main -m "appropriate message" - -tag new version of clm branch - review naming conventions! -> svn copy $SVN/clm2/branches/ $SVN/clm2/branch_tags/_tags/ -m "appropriate message" - -have external directories in working copy refer to new clm tag -> svn switch $SVN/clm2/branch_tags/_tags//src/main main - -modify cam's property for external definitions in working copy -> emacs cam_trunk_head_wc/SVN_EXTERNAL_DIRECTORIES - ---point definition to URL of new-tag-name-- - -set the property - don't forget the 'dot' at the end! -> svn propset svn:externals -F SVN_EXTERNAL_DIRECTORIES cam_trunk_head_wc - ---continue with other cam mods-- - -commit changes from working copy directory to HEAD of cam trunk - NOTE: a commit from here will *NOT* recurse to external directories -> cd cam_trunk_head_wc -> svn commit -m "appropriate message" - -tag new version of cam trunk -> svn copy $SVN/cam1/trunk $SVN/cam1/trunk_tags/ -m "appropriate message" diff --git a/bin/git-fleximod b/bin/git-fleximod new file mode 100755 index 0000000000..f69ede1c22 --- /dev/null +++ b/bin/git-fleximod @@ -0,0 +1,8 @@ +#!/usr/bin/env python3 +import sys +import os +sys.path.insert(0,os.path.abspath(os.path.join(os.path.dirname(__file__),"..",".lib","git-fleximod"))) +from git_fleximod.git_fleximod import main + +if __name__ == '__main__': + sys.exit(main()) diff --git a/bld/build-namelist b/bld/build-namelist index 0c56fff055..7a5c8c1132 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -1566,7 +1566,7 @@ elsif ($carma eq 'tholin') { # turn on stratospheric aerosol forcings in CAM6 configurations my $chem_has_ocs = chem_has_species($cfg, 'OCS'); -if (($phys =~ /cam6/ or $phys =~ /cam_dev/) and $chem =~ /_mam/) { +if (($phys =~ /cam6/ or $phys =~ /cam7/) and $chem =~ /_mam/) { # turn on volc forcings in cam6 -- prognostic or prescribed if ( $chem_has_ocs ) { # turn on prognostic stratospheric aerosols @@ -1596,9 +1596,9 @@ if (chem_has_species($cfg, 'O3S')) { # stratospheric aerosols are needed for heterogeneous chemistry as well as radiation feedback my $het_chem = chem_has_species($cfg, 'N2O5'); -# Default for CAM6, is that prescribed_strataero_3modes is TRUE, but allow user to override +# Default for cam6 and cam7 is that prescribed_strataero_3modes is TRUE, but allow user to override my $prescribed_strataero_3modes = $FALSE; -if ($phys =~ /cam6/ or $phys =~ /cam_dev/) { +if ($phys =~ /cam6/ or $phys =~ /cam7/) { $prescribed_strataero_3modes = $TRUE; } if (defined $nl->get_value('prescribed_strataero_3modes')) { @@ -1854,7 +1854,7 @@ my $megan_emis = defined $nl->get_value('megan_specifier'); if ( $megan_emis ) { add_default($nl, 'megan_factors_file'); } # Tropospheric full chemistry options -if (($chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) and ($phys !~ /cam6/) and ($phys !~ /cam_dev/)) { +if (($chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) and ($phys !~ /cam6/) and ($phys !~ /cam7/)) { # Surface emission datasets: my %verhash; @@ -2228,7 +2228,7 @@ if ($chem eq 'trop_mam3') { } # CMIP6 emissions -if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam_dev/)) { +if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam7/)) { # OASISS (ocean) DMS emissions if (!$aqua_mode and !$scam) { @@ -2306,14 +2306,8 @@ if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam # for troposphere gas-phase chemistry if ($chem =~ /trop_strat/ or $chem =~ /_tsmlt/) { %species = (%species, - 'BENZENE_an_srf_file' => 'BENZENE', - 'BENZENE_bb_srf_file' => 'BENZENE', 'BIGALK_an_srf_file' => 'BIGALK', 'BIGALK_bb_srf_file' => 'BIGALK', - 'BIGENE_an_srf_file' => 'BIGENE', - 'BIGENE_bb_srf_file' => 'BIGENE', - 'C2H2_an_srf_file' => 'C2H2', - 'C2H2_bb_srf_file' => 'C2H2', 'C2H4_an_srf_file' => 'C2H4', 'C2H4_bb_srf_file' => 'C2H4', 'C2H4_ot_srf_file' => 'C2H4', @@ -2330,8 +2324,6 @@ if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam 'C3H8_ot_srf_file' => 'C3H8', 'CH3CHO_an_srf_file' => 'CH3CHO', 'CH3CHO_bb_srf_file' => 'CH3CHO', - 'CH3CN_an_srf_file' => 'CH3CN', - 'CH3CN_bb_srf_file' => 'CH3CN', 'CH3COCH3_an_srf_file' => 'CH3COCH3', 'CH3COCH3_bb_srf_file' => 'CH3COCH3', 'CH3COCHO_bb_srf_file' => 'CH3COCHO', @@ -2340,25 +2332,39 @@ if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam 'CH3OH_an_srf_file' => 'CH3OH', 'CH3OH_bb_srf_file' => 'CH3OH', 'GLYALD_bb_srf_file' => 'GLYALD', + 'ISOP_bb_srf_file' => 'ISOP', + 'NH3_an_srf_file' => 'NH3', + 'NH3_bb_srf_file' => 'NH3', + 'NH3_ot_srf_file' => 'NH3', + 'E90_srf_file' => 'E90' ); + if ($chem !~ /_ts4/) { + %species = (%species, + 'BENZENE_an_srf_file' => 'BENZENE', + 'BENZENE_bb_srf_file' => 'BENZENE', + 'BIGENE_an_srf_file' => 'BIGENE', + 'BIGENE_bb_srf_file' => 'BIGENE', + 'C2H2_an_srf_file' => 'C2H2', + 'C2H2_bb_srf_file' => 'C2H2', + 'CH3CN_an_srf_file' => 'CH3CN', + 'CH3CN_bb_srf_file' => 'CH3CN', 'HCN_an_srf_file' => 'HCN', 'HCN_bb_srf_file' => 'HCN', 'HCOOH_an_srf_file' => 'HCOOH', 'HCOOH_bb_srf_file' => 'HCOOH', - 'ISOP_bb_srf_file' => 'ISOP', 'MEK_an_srf_file' => 'MEK', 'MEK_bb_srf_file' => 'MEK', - 'NH3_an_srf_file' => 'NH3', - 'NH3_bb_srf_file' => 'NH3', - 'NH3_ot_srf_file' => 'NH3', 'TOLUENE_an_srf_file' => 'TOLUENE', 'TOLUENE_bb_srf_file' => 'TOLUENE', 'XYLENES_an_srf_file' => 'XYLENES', - 'XYLENES_bb_srf_file' => 'XYLENES', - 'E90_srf_file' => 'E90' ); + 'XYLENES_bb_srf_file' => 'XYLENES' ) ; + } if ($chem =~ /trop_strat_mam4_ts2/ or $chem =~ /trop_strat_mam5_ts2/) { %species = (%species, 'MTERP_bb_srf_file' => 'APIN') ; - } else { + } elsif ($chem =~ /_ts4/) { + %species = (%species, + 'MTERP_bb_srf_file' => 'TERP') ; + } else { %species = (%species, 'MTERP_bb_srf_file' => 'MTERP' ); } @@ -2380,7 +2386,7 @@ if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam 'IVOC_bb_srf_file' => 'IVOCbb', 'SVOC_an_srf_file' => 'SVOCff', 'SVOC_bb_srf_file' => 'SVOCbb' ); - } else { + } elsif ($chem !~ /_ts4/) { %species = (%species, 'IVOC_an_srf_file' => 'IVOC', 'IVOC_bb_srf_file' => 'IVOC', @@ -2389,7 +2395,7 @@ if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam } } - # Note, this section might need to be modified if cam_dev values + # Note, this section might need to be modified if cam7 values # diverge from cam6 values my %verhash = ('ver'=>'cam6'); my $first = 1; @@ -2405,7 +2411,7 @@ if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam $first = 0; } } - if ($chem eq 'trop_mam4' or $chem eq 'waccm_sc_mam4'or $chem eq 'ghg_mam4') { + if ($chem eq 'trop_mam4' or $chem eq 'waccm_sc_mam4' or $chem eq 'ghg_mam4' or $chem =~ /_ts4/) { # SOA yields (used for the interactive emissions) have been calculated based on the VBS yields in CAM-chem. # Duseong S. Jo, et al. to be submitted to GMD, 2023 -- see https://github.com/ESCOMP/CAM/pull/727 discussion for additional detail. my %soae_fctrs = ('BENZENE_an_srf_file' => '2.5592D0', @@ -2615,6 +2621,38 @@ if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam add_default($nl, 'megan_factors_file'); add_default($nl, 'megan_mapped_emisfctrs', 'val'=>'.false.'); } + if ($chem =~ /trop_strat_mam5_ts4/) { + my $val = "'ISOP = isoprene'," + . "'TERP = carene_3 + pinene_a + thujene_a + bornene + terpineol_4 + terpineol_a + terpinyl_ACT_a +'," + . "' myrtenal + sabinene + pinene_b + camphene + fenchene_a + limonene + phellandrene_a + terpinene_a +'," + . "' terpinene_g + terpinolene + phellandrene_b + linalool + ionone_b + geranyl_acetone + neryl_acetone +'," + . "' jasmone + verbenene + ipsenol + myrcene + ocimene_t_b + ocimene_al + ocimene_c_b + 2met_nonatriene +'," + . "' farnescene_a + caryophyllene_b + acoradiene + aromadendrene + bergamotene_a + bergamotene_b +'," + . "' bisabolene_a + bisabolene_b + bourbonene_b + cadinene_d + cadinene_g + cedrene_a + copaene_a +'," + . "' cubebene_a + cubebene_b + elemene_b + farnescene_b + germacrene_B + germacrene_D + gurjunene_b +'," + . "' humulene_a + humulene_g + isolongifolene + longifolene + longipinene + muurolene_a + muurolene_g +'," + . "' selinene_b + selinene_d + nerolidol_c + nerolidol_t'," + . "'BIGALK = tricyclene + camphor + fenchone + thujone_a + thujone_b + cineole_1_8 + borneol + bornyl_ACT +'," + . "' cedrol + decanal + heptanal + heptane + hexane + nonanal + octanal + octanol + oxopentanal + pentane +'," + . "' hexanal + hexanol_1 + pentanal + heptanone', 'CH3OH = methanol'," + . "'CH3COCH3 = acetone', 'CH3CHO = acetaldehyde', 'C2H5OH = ethanol'," + . "'CH2O = formaldehyde', 'CH3COOH = acetic_acid', 'CO = carbon_monoxide'," + . "'C2H6 = ethane', 'C2H4 = ethene', 'C3H8 = propane', 'C3H6 = propene'," + . "'SOAE = 0.5954*isoprene + 5.1004*(carene_3 + pinene_a + thujene_a + bornene +'," + . "' terpineol_4 + terpineol_a + terpinyl_ACT_a + myrtenal + sabinene + pinene_b + camphene +'," + . "' fenchene_a + limonene + phellandrene_a + terpinene_a + terpinene_g + terpinolene +'," + . "' phellandrene_b + linalool + ionone_b + geranyl_acetone + neryl_acetone + jasmone +'," + . "' verbenene + ipsenol + myrcene + ocimene_t_b + ocimene_al + ocimene_c_b + 2met_nonatriene) + '," + . "' 12.3942*(farnescene_a + caryophyllene_b + acoradiene + aromadendrene + bergamotene_a +'," + . "' bergamotene_b + bisabolene_a + bisabolene_b + bourbonene_b + cadinene_d + cadinene_g +'," + . "' cedrene_a + copaene_a + cubebene_a + cubebene_b + elemene_b + farnescene_b +'," + . "' germacrene_B + germacrene_D + gurjunene_b + humulene_a + humulene_g + isolongifolene +'," + . "' longifolene + longipinene + muurolene_a + muurolene_g + selinene_b + selinene_d +'," + . "' nerolidol_c + nerolidol_t)'"; + add_default($nl, 'megan_specifier', 'val'=>$val); + add_default($nl, 'megan_factors_file'); + add_default($nl, 'megan_mapped_emisfctrs', 'val'=>'.false.'); + } if ($chem =~ /trop_strat_mam4_ts2/ or $chem =~ /trop_strat_mam5_ts2/) { my $val = "'ISOP = isoprene'," . "'APIN = pinene_a + myrtenal'," @@ -3082,6 +3120,7 @@ if ($waccmx) { add_default($nl,'ionos_xport_nsplit'); add_default($nl,'steady_state_ion_elec_temp', 'val'=>'.false.'); add_default($nl,'oplus_ring_polar_filter'); + add_default($nl,'rxn_rate_sums'); } # Chemistry options @@ -3150,15 +3189,15 @@ if (($chem ne 'none') and ($chem ne 'terminator') and !($chem =~ /geoschem/)) { add_default($nl, 'deep_scheme'); # Aerosol convective processes -if (($phys =~ /cam6/ or $phys =~ /cam_dev/) and $nl->get_value('deep_scheme') =~ /ZM/) { +if (($phys =~ /cam6/ or $phys =~ /cam7/) and $nl->get_value('deep_scheme') =~ /ZM/) { add_default($nl, 'convproc_do_aer', 'val'=>'.true.'); add_default($nl, 'convproc_do_evaprain_atonce', 'val'=>'.true.'); add_default($nl, 'convproc_pom_spechygro', 'val'=>'0.2D0'); add_default($nl, 'convproc_wup_max', 'val'=>'4.0D0'); } -# cam_dev specific namelists -if ($phys =~ /cam_dev/ and $nl->get_value('deep_scheme') =~ /ZM/) { +# cam7 specific namelists +if ($phys =~ /cam7/ and $nl->get_value('deep_scheme') =~ /ZM/) { add_default($nl, 'zmconv_parcel_pbl', 'val'=>'.true.'); } else { add_default($nl, 'zmconv_parcel_pbl', 'val'=>'.false.'); @@ -3211,8 +3250,8 @@ if ($cfg->get('microphys') =~ /^mg/) { # namelist options for pumas tag release_v1.22 or later - # (currently only in the cam_dev physics package) - if ($phys =~ /cam_dev/) { + # (currently only in the cam7 physics package) + if ($phys =~ /cam7/) { add_default($nl, 'micro_mg_warm_rain'); add_default($nl, 'micro_mg_accre_sees_auto'); add_default($nl, 'micro_mg_vtrms_factor'); @@ -3226,10 +3265,10 @@ if ($cfg->get('microphys') =~ /^mg/) { my $abs_path = quote_string(set_abs_filepath($rel_path, $cam_dir)); #overwrite the relative pathname with the absolute pathname $nl->set_variable_value('pumas_stochastic_tau_nl', 'pumas_stochastic_tau_kernel_filename', $abs_path); - + }else { # For CESM2, the decision was made to set micro_do_sb_physics to false - # This variable is replaced with micro_mg_warm_rain in cam_dev runs + # This variable is replaced with micro_mg_warm_rain in cam7 runs add_default($nl, 'micro_do_sb_physics', 'val'=>'.false.'); } @@ -3245,13 +3284,13 @@ if ($cfg->get('microphys') =~ /^mg/) { $micro_mg_dcs = '390.D-6'; # default for SIHLS } elsif ($hgrid =~ /1.9x2.5/ and $phys eq 'cam6') { - $micro_mg_dcs = '200.D-6'; # default for FV 2-deg + $micro_mg_dcs = '200.D-6'; } elsif ($phys eq 'cam6') { - $micro_mg_dcs = '500.D-6'; # default for cam6 + $micro_mg_dcs = '500.D-6'; } - elsif ($phys eq 'cam_dev') { - $micro_mg_dcs = '500.D-6'; # default for cam_dev + elsif ($phys eq 'cam7') { + $micro_mg_dcs = '500.D-6'; } } @@ -3357,6 +3396,12 @@ if ($use_subcol_microp =~ /$TRUE/io) { } # CLUBB_SGS +my $do_clubb_sgs = $nl->get_value('do_clubb_sgs'); +if (defined $do_clubb_sgs) { + die "CAM Namelist ERROR: User may not specify the value of do_clubb_sgs.\n". + "This variable is set by build-namelist based on information\n". + "from the configure cache file.\n"; +} add_default($nl, 'do_clubb_sgs'); my $clubb_sgs = $nl->get_value('do_clubb_sgs'); if ($clubb_sgs =~ /$TRUE/io) { @@ -3446,6 +3491,7 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'clubb_gamma_coefb'); } + add_default($nl, 'clubb_bv_efold'); add_default($nl, 'clubb_C7'); add_default($nl, 'clubb_C7b'); add_default($nl, 'clubb_c_K1'); @@ -3510,6 +3556,8 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'clubb_tridiag_solve_method'); add_default($nl, 'clubb_up2_sfc_coef'); add_default($nl, 'clubb_wpxp_L_thresh'); + add_default($nl, 'clubb_wpxp_Ri_exp'); + add_default($nl, 'clubb_z_displace'); #CLUBB+MF options add_default($nl, 'do_clubb_mf'); @@ -3522,13 +3570,6 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'do_hb_above_clubb'); } -# Force exit if running cam_dev and CLUBB is off -if ($phys eq 'cam_dev') { - if ($clubb_sgs =~ /$FALSE/io) { - die "$ProgName - ERROR: If running cam_dev physics, do_clubb_sgs must be .true.\n"; - } -} - # Tuning for wet scavenging of modal aerosols if ($chem =~ /_mam/) { add_default($nl, 'sol_facti_cloud_borne'); @@ -3716,7 +3757,7 @@ if ($chem =~ /_mam(\d)/) { # By default, orographic waves are always on if (!$simple_phys) { - if ($phys =~ /cam6/ or $phys =~ /cam_dev/) { + if ($phys =~ /cam6/ or $phys =~ /cam7/) { add_default($nl, 'use_gw_oro', 'val'=>'.false.'); @@ -3733,6 +3774,10 @@ if (!$simple_phys) { add_default($nl, 'use_gw_rdg_beta', 'val'=>'.false.'); } + if ($phys =~ /cam7/) { + add_default($nl, 'use_gw_movmtn_pbl', 'val'=>'.true.'); + } + add_default($nl, 'use_gw_rdg_gamma' , 'val'=>'.false.'); add_default($nl, 'use_gw_front_igw' , 'val'=>'.false.'); add_default($nl, 'use_gw_convect_sh', 'val'=>'.false.'); @@ -3747,7 +3792,7 @@ if (!$simple_phys) { } if ($waccm_phys or - (!$simple_phys and $cfg->get('nlev') >= 60)) { + (!$simple_phys and $cfg->get('model_top') eq 'mt')) { # Spectral gravity waves are part of WACCM physics, and also drive the # QBO in the high vertical resolution configuration. add_default($nl, 'use_gw_front' , 'val'=>'.true.'); @@ -3770,8 +3815,8 @@ if ($waccm_phys or } add_default($nl, 'gw_qbo_hdepth_scaling', 'val'=>$hdepth_scaling); add_default($nl, 'gw_top_taper'); -} elsif ($phys =~ /cam_dev/) { - # cam_dev settings for nlev<60 (Other cam_dev set above) +} elsif ($phys =~ /cam7/) { + # cam7 settings for model_top = 'lt' add_default($nl, 'use_gw_front' , 'val'=>'.true.'); add_default($nl, 'use_gw_convect_dp', 'val'=>'.true.'); add_default($nl, 'gw_qbo_hdepth_scaling', 'val'=>'1.0D0'); @@ -3786,6 +3831,7 @@ my $do_gw_front = ($nl->get_value('use_gw_front') =~ /$TRUE/io); my $do_gw_front_igw = ($nl->get_value('use_gw_front_igw') =~ /$TRUE/io); my $do_gw_convect_dp = ($nl->get_value('use_gw_convect_dp') =~ /$TRUE/io); my $do_gw_convect_sh = ($nl->get_value('use_gw_convect_sh') =~ /$TRUE/io); +my $do_gw_movmtn_pbl = ($nl->get_value('use_gw_movmtn_pbl') =~ /$TRUE/io); my $do_gw_rdg_beta = ($nl->get_value('use_gw_rdg_beta') =~ /$TRUE/io); my $do_gw_rdg_gamma = ($nl->get_value('use_gw_rdg_gamma') =~ /$TRUE/io); @@ -3843,6 +3889,11 @@ if ($do_gw_convect_sh) { add_default($nl, 'effgw_beres_sh'); } +if ($do_gw_movmtn_pbl) { + add_default($nl, 'gw_drag_file_mm'); + add_default($nl, 'alpha_gw_movmtn'); +} + if ($do_gw_rdg_beta) { if ($use_topo_file =~ m/$FALSE/io) { die "$ProgName - ERROR: beta ridge scheme requires data from a topo file.\n"; @@ -3907,7 +3958,7 @@ if ((not $waccm_phys) and ($do_gw_front or $do_gw_front_igw or $do_gw_convect_dp or $do_gw_convect_sh )) { add_default($nl, 'tau_0_ubc', 'val'=>'.true.'); -} elsif ($phys =~ /cam_dev/) { +} elsif ($phys =~ /cam7/) { add_default($nl, 'tau_0_ubc', 'val'=>'.true.'); } elsif (!$simple_phys) { add_default($nl, 'tau_0_ubc', 'val'=>'.false.'); @@ -4103,6 +4154,7 @@ if ($dyn =~ /se/) { se_kmax_jet se_molecular_diff se_pgf_formulation + se_dribble_in_rsplit_loop ); my %opts; @@ -5080,8 +5132,8 @@ sub check_snapshot_settings { if ($chem ne 'none') { push (@validList_bc, ("'chem_timestep_tend'")); } - } elsif ($phys =~ /cam_dev/) { - # CAM_DEV physpkg + } elsif ($phys =~ /cam7/) { + # cam7 physpkg push(@validList_ac, ("'chem_emissions'", "'clubb_tend_cam'", "'microp_section'")); diff --git a/bld/config_files/definition.xml b/bld/config_files/definition.xml index 03f2f10405..86cfc80a8c 100644 --- a/bld/config_files/definition.xml +++ b/bld/config_files/definition.xml @@ -57,8 +57,8 @@ Option to turn on waccmx thermosphere/ionosphere extension: 0 => no, 1 => yes Ionosphere model used in WACCMX. - -Physics package: cam3, cam4, cam5, cam6, cam_dev, held_suarez, adiabatic, kessler, tj2016, grayrad, spcam_sam1mom, spcam_m2005. + +Physics package: cam3, cam4, cam5, cam6, cam7, held_suarez, adiabatic, kessler, tj2016, grayrad, spcam_sam1mom, spcam_m2005. Switch to turn on Harmonized Emissions Component (HEMCO) for chemistry: 0 => no, 1 => yes. @@ -103,8 +103,8 @@ meteor_smoke (Meteor Smoke), mixed_sulfate (Meteor Smoke and Sulfate), pmc (Pola sulfate (Sulfate Aerosols), tholin (early earth haze), test_detrain (Detrainment), test_growth (Particle Growth), test_passive (Passive Dust), test_radiative (Radiatively Active Dust), test_swelling (Sea Salt), test_tracers (Asian Monsoon), test_tracers2 (Guam). - - Chemistry package: none,ghg_mam4,terminator,trop_mam3,trop_mam4,trop_mam7,trop_mozart,trop_strat_mam4_ts2,trop_strat_mam4_vbs,trop_strat_mam4_vbsext,trop_strat_mam5_ts2,trop_strat_mam5_vbs,trop_strat_mam5_vbsext,waccm_ma,waccm_mad,waccm_ma_sulfur,waccm_sc,waccm_sc_mam4,waccm_mad_mam4,waccm_ma_mam4,waccm_tsmlt_mam4,waccm_tsmlt_mam4_vbsext,waccm_mad_mam5,waccm_ma_mam5,waccm_tsmlt_mam5,waccm_tsmlt_mam5_vbsext,geoschem_mam4 + + Chemistry package: none,ghg_mam4,terminator,trop_mam3,trop_mam4,trop_mam7,trop_mozart,trop_strat_mam4_ts2,trop_strat_mam4_vbs,trop_strat_mam4_vbsext,trop_strat_mam5_ts2,trop_strat_mam5_ts4,trop_strat_mam5_vbs,trop_strat_mam5_vbsext,waccm_ma,waccm_mad,waccm_ma_sulfur,waccm_sc,waccm_sc_mam4,waccm_mad_mam4,waccm_ma_mam4,waccm_tsmlt_mam4,waccm_tsmlt_mam4_vbsext,waccm_mad_mam5,waccm_ma_mam5,waccm_tsmlt_mam5,waccm_tsmlt_mam5_vbsext,geoschem_mam4 Prognostic mozart species packages: list of any subset of the following: DST,SSLT,SO4,GHG,OC,BC,CARBON16 @@ -127,7 +127,7 @@ Chemistry source directory generated by the chemistry preprocessor; contains F90 Chemistry source directory; contains F90 files. - + Use data ocean model (docn or dom), stub ocean (socn), or aqua planet ocean (aquaplanet) in cam build. When built from the CESM scripts the value of ocn may be set to pop. This doesn't impact how CAM is built, only how diff --git a/bld/configure b/bld/configure index 974c30dc5e..a5bb9da324 100755 --- a/bld/configure +++ b/bld/configure @@ -64,12 +64,12 @@ OPTIONS Default: none. -chem Build CAM with specified prognostic chemistry package [ none | ghg_mam4 | terminator | trop_mam3 | trop_mam4 | trop_mam7 | trop_mozart | trop_strat_mam4_ts2 | - trop_strat_mam4_vbs | trop_strat_mam4_vbsext | trop_strat_mam5_ts2 | trop_strat_mam5_vbs | + trop_strat_mam4_vbs | trop_strat_mam4_vbsext | trop_strat_mam5_ts2 | trop_strat_mam5_ts4 | trop_strat_mam5_vbs | trop_strat_mam5_vbsext | waccm_ma | waccm_mad | waccm_ma_sulfur | waccm_sc | waccm_sc_mam4 | waccm_mad_mam4 | waccm_ma_mam4 | waccm_tsmlt_mam4 | waccm_tsmlt_mam4_vbsext | waccm_mad_mam5 | waccm_ma_mam5 | waccm_tsmlt_mam5 | waccm_tsmlt_mam5_vbsext | geoschem_mam4 ]. Default: trop_mam4 for cam6 and trop_mam3 for cam5. - -[no]clubb_sgs Switch on [off] CLUBB_SGS. Default: on for cam6, otherwise off. + -[no]clubb_sgs Switch on [off] CLUBB_SGS. Default: on for cam6 and cam7, otherwise off. -clubb_opts Comma separated list of CLUBB options to turn on/off. By default they are all off. Current option is: clubb_do_adv (Advect CLUBB moments) -co2_cycle This option modifies the CAM configuration by @@ -89,7 +89,7 @@ OPTIONS -max_n_rad_cnst Maximum number of constituents that are either radiatively active, or in any single diagnostic list for the radiation. -microphys Specify the microphysics option [mg1 | mg2 | mg3| rk | pumas]. - -model_top Specify the model_top option [ lt | mt ]. + -model_top Specify the model_top option for cam7 [ lt | mt ]. -nadv Set total number of advected species to . -nadv_tt Set number of advected test tracers . -nlev Set number of levels to . @@ -97,7 +97,7 @@ OPTIONS -pbl Specify the PBL option [uw | hb | hbr]. -pcols Set maximum number of columns in a chunk to . -pergro Switch enables building CAM for perturbation growth tests. - -phys Physics option [cam3 | cam4 | cam5 | cam6 | cam_dev | + -phys Physics option [cam3 | cam4 | cam5 | cam6 | cam7 | held_suarez | adiabatic | kessler | tj2016 | grayrad spcam_sam1mom | spcam_m2005]. Default: cam6 -prog_species Comma-separate list of prognostic mozart species packages. @@ -209,6 +209,7 @@ EOF # command was issued from the current working directory. (my $ProgName = $0) =~ s!(.*)/!!; # name of this script +$ProgName = "CAM $ProgName"; # distinquish from other components configure my $ProgDir = $1; # name of directory containing this script -- may be a # relative or absolute path, or null if the script is in # the user's PATH @@ -534,21 +535,16 @@ if ($print>=2) { print "Coupling framework: $cpl$eol"; } #----------------------------------------------------------------------------------------------- # Physics package -# -# The default physics package is cam6. Physics packages >=cam5 use chemistry packages -# that include modal aerosols, i.e., the -chem value matches /_mam/. If the chem_pkg -# name doesn't match /_mam/ then set the default physics package to cam4. -my $phys_pkg = 'cam6'; -if (defined $opts{'chem'} and $opts{'chem'} !~ /_mam/) { - $phys_pkg = 'cam4'; -} -elsif (defined $opts{'waccmx'}) { - $phys_pkg = 'cam4'; -} -# user override +my $phys_pkg = 'not_set'; + +# There is no default physics package. It is always specified by the CAM component part +# of a compset longname. Add check that -phys has been set. + if (defined $opts{'phys'}) { $phys_pkg = lc($opts{'phys'}); +} else { + die "$ProgName ERROR: the -phys option must be set"; } # Add to the config object. @@ -566,7 +562,7 @@ if ($phys_pkg =~ m/^adiabatic$|^held_suarez$|^kessler$|^tj2016$|^grayrad$/) { #----------------------------------------------------------------------------------------------- # Chemistry package -my $chem_pkg = 'trop_mam4'; +my $chem_pkg = 'not_set'; # defaults based on physics package if ($simple_phys or $phys_pkg =~ m/^cam[34]$/ or $phys_pkg eq 'spcam_sam1mom') { @@ -575,6 +571,12 @@ if ($simple_phys or $phys_pkg =~ m/^cam[34]$/ or $phys_pkg eq 'spcam_sam1mom') { elsif ($phys_pkg eq 'cam5' or $phys_pkg eq 'spcam_m2005') { $chem_pkg = 'trop_mam3'; } +elsif ($phys_pkg eq 'cam6') { + $chem_pkg = 'trop_mam4'; +} +elsif ($phys_pkg eq 'cam7') { + $chem_pkg = 'ghg_mam4'; +} # some overrides for special configurations if (defined $opts{'prog_species'}) { @@ -639,6 +641,10 @@ if ($dyn_pkg eq 'fv3' and $spmd eq 'OFF') { die "configure: FATAL: the fv3 dycore requires at least 6 tasks SPMD must not be switched off.$eol"; } +if ($dyn_pkg eq 'se' and $smp eq 'ON') { + die "CAM configure: ERROR: The SE dycore does not currently work with threading on. $eol"; +} + if ($print>=2) { print "Dynamics package: $dyn_pkg$eol"; } $cfg_ref->set('analytic_ic', (defined $opts{'analytic_ic'}) ? $opts{'analytic_ic'} : 0); @@ -675,17 +681,6 @@ my $max_n_rad_cnst = $cfg_ref->get('max_n_rad_cnst'); if ($print>=2) { print "Maximum radiatively active tracers: $max_n_rad_cnst$eol"; } -#----------------------------------------------------------------------------------------------- -# model_top - not set by default -my $model_top = 'none'; -$cfg_ref->set('model_top', $model_top); - -# user override -if (defined $opts{'model_top'}) { - $cfg_ref->set('model_top', $opts{'model_top'}); -} -if ($print>=2) { print "model_top: $model_top$eol"; } - #----------------------------------------------------------------------------------------------- # waccm physics my $waccm_phys = 0; @@ -823,7 +818,7 @@ elsif ($phys_pkg eq 'cam5') { elsif ($phys_pkg eq 'cam6') { $microphys_pkg = 'mg2'; } -elsif ($phys_pkg eq 'cam_dev') { +elsif ($phys_pkg eq 'cam7') { $microphys_pkg = 'mg3'; } elsif ($phys_pkg eq 'spcam_sam1mom') { @@ -872,7 +867,7 @@ if ($print>=2) { print "CARMA microphysical model: $carma_pkg$eol"; } #----------------------------------------------------------------------------------------------- # CLUBB my $clubb_sgs = 0; -if ($phys_pkg eq 'cam6' or $phys_pkg eq 'cam_dev') { +if ($phys_pkg eq 'cam6' or $phys_pkg eq 'cam7') { $clubb_sgs = 1; } @@ -883,6 +878,13 @@ if (defined $opts{'clubb_sgs'}) { # consistency checks... +# cam7 only works with CLUBB_SGS +if (($phys_pkg eq 'cam7') and not ($clubb_sgs )) { + die <<"EOF"; +** ERROR: CLUBB_SGS must be enabled for cam7 physics. +EOF +} + # CLUBB_SGS only works with mg microphysics if ($clubb_sgs and not ($microphys_pkg =~ m/^mg/ )) { die <<"EOF"; @@ -955,13 +957,15 @@ if ($phys_pkg =~ /cam[34]/) { elsif ($phys_pkg =~ /cam5/) { $macrophys_pkg = 'park'; } -elsif ($phys_pkg =~ /cam6/ and $clubb_sgs) { - $macrophys_pkg = 'clubb_sgs'; -} -elsif ($phys_pkg =~ /cam6/ and !$clubb_sgs) { - $macrophys_pkg = 'park'; +elsif ($phys_pkg =~ /cam6/) { + if ($clubb_sgs) { + $macrophys_pkg = 'clubb_sgs'; + } + else { + $macrophys_pkg = 'park'; + } } -elsif ($phys_pkg =~ /cam_dev/ and $clubb_sgs) { +elsif ($phys_pkg =~ /cam7/ and $clubb_sgs) { $macrophys_pkg = 'clubb_sgs'; } elsif ($phys_pkg eq 'spcam_sam1mom') { @@ -996,13 +1000,15 @@ if ($phys_pkg =~ m/^cam[34]$/) { elsif ($phys_pkg =~ /cam5/) { $pbl_pkg = 'uw'; } -elsif ($phys_pkg =~ /cam6/ and $clubb_sgs) { - $pbl_pkg = 'clubb_sgs'; -} -elsif ($phys_pkg =~ /cam6/ and !$clubb_sgs) { - $pbl_pkg = 'uw'; +elsif ($phys_pkg =~ /cam6/) { + if ($clubb_sgs) { + $pbl_pkg = 'clubb_sgs'; + } + else { + $pbl_pkg = 'uw'; + } } -elsif ($phys_pkg =~ /cam_dev/ and $clubb_sgs) { +elsif ($phys_pkg =~ /cam7/ and $clubb_sgs) { $pbl_pkg = 'clubb_sgs'; } elsif ($phys_pkg eq 'spcam_sam1mom') { @@ -1062,10 +1068,10 @@ if ($unicon and $print>=2) { print "Using UNICON scheme.$eol"; } # Set default my $rad_pkg = 'none'; -if ($phys_pkg =~ m/^cam[34]$|^spcam_sam1mom$/) { +if ($phys_pkg =~ m/cam3|cam4|spcam_sam1mom/) { $rad_pkg = 'camrt'; } -elsif ($phys_pkg =~ m/^cam[56]$|^cam_dev$|^spcam_m2005$/) { +elsif ($phys_pkg =~ m/cam5|cam6|cam7|spcam_m2005/) { $rad_pkg = 'rrtmg'; } # Allow the user to override the default via the commandline. @@ -1116,8 +1122,8 @@ if (defined $opts{'cosp'}) { } my $cosp = $cfg_ref->get('cosp'); -# cosp is only implemented with the cam5 and cam6 physics packages -if ($cosp and ($phys_pkg ne 'cam5' and $phys_pkg ne 'cam6' and $phys_pkg ne 'cam_dev')) { +# cosp is only implemented with the cam5, cam6, and cam7 physics packages +if ($cosp and ($phys_pkg ne 'cam5' and $phys_pkg ne 'cam6' and $phys_pkg ne 'cam7')) { die "configure ERROR: cosp not implemented for the $phys_pkg physics package \n"; } @@ -1300,6 +1306,24 @@ EOF if ($print>=2) { print "Maximum number of sub-columns per column: $psubcols$eol"; } +#----------------------------------------------------------------------------------------------- +# model_top -- Introduced in cam7 to provide a way to specify the model top +# independently of the number of model layers. + +# Set default +my $model_top = 'none'; +$cfg_ref->set('model_top', $model_top); + +# user override +if (defined $opts{'model_top'} and $opts{'model_top'} ne 'none') { + if ($phys_pkg eq 'cam7') { + $cfg_ref->set('model_top', $opts{'model_top'}); + } else { + die "configure ERROR: model_top=$opts{'model_top'} is only implemented for cam7 physics"; + } +} +if ($print>=2) { print "model_top: $model_top$eol"; } + #----------------------------------------------------------------------------------------------- # Number of vertical levels my $nlev = 0; @@ -1308,7 +1332,7 @@ my $nlev = 0; if ($waccmx) { if ($phys_pkg eq 'cam6') { $nlev = 130; - } elsif ($phys_pkg eq 'cam_dev') { + } elsif ($phys_pkg eq 'cam7') { $nlev = 130; } else { $nlev = 126; @@ -1322,7 +1346,7 @@ elsif ($chem_pkg =~ /waccm_/) { $nlev = 70; } } -elsif ($phys_pkg eq 'cam_dev') { +elsif ($phys_pkg eq 'cam7') { $nlev = 32; } elsif ($phys_pkg eq 'cam6') { @@ -1696,7 +1720,7 @@ elsif ($fc =~ /nvfor/) { $fc_type = 'nvhpc'; } # User override for Fortran compiler type if (defined $opts{'fc_type'}) { $fc_type = $opts{'fc_type'}; } -if ($fc_type eq "oneapi") {$fc_type = 'intel'; } +if ($fc_type =~ /intel/) {$fc_type = 'intel'; } if ($fc_type) { $cfg_ref->set('fc_type', $fc_type); if ($print>=2) { print "Fortran compiler type: $fc_type$eol"; } @@ -2101,6 +2125,7 @@ sub write_fv3core_filepath my $camsrcdir = $cfg_ref->get('cam_dir'); my $CASEROOT = "$ENV{'CASEROOT'}"; print $fh "$CASEROOT/SourceMods/src.cam\n"; + print $fh "$camsrcdir/src/dynamics/fv3/src_override\n"; print $fh "$camsrcdir/src/dynamics/fv3/microphys\n"; print $fh "$camsrcdir/src/dynamics/fv3/atmos_cubed_sphere/model\n"; print $fh "$camsrcdir/src/dynamics/fv3/atmos_cubed_sphere/tools\n"; @@ -2156,19 +2181,20 @@ sub write_filepath print $fh "$camsrcdir/src/unit_drivers\n"; print $fh "$camsrcdir/src/unit_drivers/${offline_drv}\n"; - if ($phys_pkg eq 'cam_dev') { - print $fh "$camsrcdir/src/physics/cam_dev\n"; + if ($phys_pkg eq 'cam7') { + print $fh "$camsrcdir/src/physics/cam7\n"; } if ($simple_phys) { print $fh "$camsrcdir/src/physics/simple\n"; print $fh "$camsrcdir/src/atmos_phys/kessler\n"; print $fh "$camsrcdir/src/atmos_phys/held_suarez\n"; + print $fh "$camsrcdir/src/atmos_phys/tj2016\n"; } # Weak scaling fix. This has to come before physics/cam and before dycores # It also has to come before utils (which is already near the end). - if ($dyn eq 'se' or $dyn eq 'mpas') { + if ($dyn eq 'se' or $dyn eq 'mpas' or $dyn eq 'fv3') { print $fh "$camsrcdir/src/infrastructure\n"; } @@ -2188,9 +2214,9 @@ sub write_filepath if ($chem_src_dir) { print $fh "$chem_src_dir\n"; } - + # GEOS-Chem must be prior to Mozart - if ($chem_pkg =~ 'geoschem') { + if ($chem_pkg =~ 'geoschem') { print $fh "$chem_src_dir/geoschem_src/GeosCore\n"; print $fh "$chem_src_dir/geoschem_src/GeosUtil\n"; print $fh "$chem_src_dir/geoschem_src/Headers\n"; @@ -2266,7 +2292,7 @@ sub write_filepath print $fh "$camsrcdir/src/physics/clubb/src/SILHS\n"; } - if ($phys_pkg eq 'cam_dev') { + if ($phys_pkg eq 'cam7') { print $fh "$camsrcdir/src/physics/pumas\n"; } else { print $fh "$camsrcdir/src/physics/pumas-frozen\n"; @@ -2302,7 +2328,7 @@ sub write_filepath print $fh "$camsrcdir/src/physics/cam\n"; #Add the CCPP'ized subdirectories - print $fh "$camsrcdir/src/atmos_phys/zm\n"; + print $fh "$camsrcdir/src/atmos_phys/zhang_mcfarlane\n"; # Dynamics package and test utilities print $fh "$camsrcdir/src/dynamics/$dyn\n"; diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 5c5ef99b93..abff5a83d6 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -56,6 +56,10 @@ atm/cam/inic/mpas/mpasa120_L93_notopo_coords_c240814.nc atm/cam/inic/mpas/mpasa60_L93_notopo_coords_c240814.nc atm/cam/inic/mpas/mpasa30_L93_notopo_coords_c240814.nc + +atm/cam/inic/mpas/mpasa15_L32_notopo_coords_c240507.nc +atm/cam/inic/mpas/mpasa15_L58_notopo_coords_c240508.nc + atm/cam/inic/fv/cami_0000-01-01_0.23x0.31_L26_c100513.nc @@ -131,10 +135,10 @@ atm/cam/inic/se/f.e22.FCnudged.ne0CONUSne30x8_ne0CONUSne30x8_mt12.cam6_2_032.002.cam.i.2013-01-01-00000_c200623.nc atm/cam/inic/se/f.e22.FCnudged.ne0CONUSne30x8_ne0CONUSne30x8_mt12.cam6_2_032.002.cam.i.2013-01-01-00000_c200623.nc atm/cam/inic/se/f.e22.FCnudged.ne30_ne30_mg17.release-cesm2.2.0_spinup.2010_2020.001.cam.i.2011-01-01-00000_L58_c220310.nc -atm/cam/inic/se/f.cam6_3_112.FCMTHIST_v0c.ne30.non-ogw-ubcT-effgw0.7.001.cam.i.1998-01-01-00000_c230810.nc +atm/cam/inic/se/f.cam6_3_160.FCMT_ne30.moving_mtn.001.cam.i.1996-01-01-00000_c240618.nc atm/cam/inic/se/FLT_L58_ne30pg3_IC_c220623.nc -atm/cam/inic/se/cam7_FMT_ne30pg3_mg17_L93_c221118.nc +atm/cam/inic/se/c153_ne30pg3_FMTHIST_x02.cam.i.1990-01-01-00000_c240618.nc atm/cam/chem/trop_mozart/ic/cami_0000-09-01_4x5_L26_c060217.nc atm/cam/chem/trop_mozart/ic/cami_0000-09-01_10x15_L26_c060216.nc @@ -224,9 +228,10 @@ atm/cam/inic/gaus/cami_0000-09-01_8x16_L26_c030918.nc atm/cam/inic/gaus/cami_0000-01-01_8x16_L30_c090102.nc +atm/cam/inic/se/FCts4MTHIST_ne3pg3_spinup02.cam.i.1980-01-01_c240702.nc atm/cam/inic/se/cam6_QPC6_topo_ne3pg3_mg37_L32_01-01-31_c221214.nc atm/cam/inic/se/cam6_QPC6_topo_ne3pg3_mg37_L58_01-01-31_c221214.nc -atm/cam/inic/se/cam6_QPC6_topo_ne3pg3_mg37_L93_01-01-31_c221214.nc +atm/cam/inic/se/cam6_FMTHIST_ne3pg3_mg37_L93_79-02-01_c240517.nc atm/cam/inic/homme/cami-mam3_0000-01_ne5np4_L30.140707.nc atm/cam/inic/se/F2000climo_ne5pg3_mg37_L32_01-01-31_c230520.nc atm/cam/inic/se/F2000climo_ne5pg3_mg37_L58_01-01-31_c230520.nc @@ -247,7 +252,7 @@ atm/cam/inic/homme/cami-mam3_0000-01-ne240np4_L30_c111004.nc -atm/cam/inic/se/ape_cam4_ne5np4_L26_c170517.nc +atm/cam/inic/se/ape_cam4_ne5np4_L26_c170517.nc atm/cam/inic/se/ape_cam4_ne16np4_L26_c170417.nc atm/cam/inic/se/ape_cam4_ne30np4_L26_c170417.nc atm/cam/inic/se/ape_cam4_ne60np4_L26_c171023.nc @@ -261,7 +266,7 @@ atm/cam/inic/se/cam6_QPC6_aqua_ne3pg3_mg37_L32_01-01-31_c221214.nc atm/cam/inic/se/cam6_QPC6_aqua_ne3pg3_mg37_L58_01-01-31_c221214.nc -atm/cam/inic/se/cam6_QPC6_aqua_ne3pg3_mg37_L93_01-01-31_c221214.nc +atm/cam/inic/se/cam6_QPC6_aqua_ne3pg3_mg37_L93_01_02_01_c240518.nc atm/cam/inic/se/ape_cam6_ne5np4_L32_c170517.nc atm/cam/inic/se/ape_cam6_ne16np4_L32_c170509.nc atm/cam/inic/se/ape_cam6_ne30np4_L32_c170509.nc @@ -288,6 +293,16 @@ atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa120_L58_CFSR_c240814.nc atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa480_L93_CFSR_c240814.nc atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa120_L93_CFSR_c240814.nc + +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa60_L32_CFSR_c210518.nc + +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa30_L32_CFSR_230302.nc + +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa120_L58_c230901.nc + +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa15_L58_c230316.nc + + atm/cam/topo/topo-from-cami_0000-01-01_256x512_L26_c030918.nc @@ -300,7 +315,7 @@ atm/cam/topo/USGS_gtopo30_0.23x0.31_remap_c061107.nc atm/cam/topo/USGS_gtopo30_0.47x0.63_remap_c061106.nc atm/cam/topo/fv_0.47x0.63_nc3000_Co030_Fi001_PF_nullRR_Nsw021_20171023.nc -atm/cam/topo/fv_0.47x0.63_nc3000_Co030_Fi001_PF_nullRR_Nsw021_20171023.nc +atm/cam/topo/fv_0.47x0.63_nc3000_Co030_Fi001_PF_nullRR_Nsw021_20171023.nc atm/cam/topo/topo-from-cami_0000-10-01_0.5x0.625_L26_c031204.nc atm/cam/topo/fv_0.9x1.25_nc3000_Nsw042_Nrs008_Co060_Fi001_ZR_sgh30_24km_GRNL_c170103.nc atm/cam/topo/fv_1.9x2.5_nc3000_Nsw084_Nrs016_Co120_Fi001_ZR_GRNL_c190405.nc @@ -330,22 +345,28 @@ atm/cam/topo/se/ne3pg3_gmted2010_modis_bedmachine_nc0540_Laplace1000_noleak_20230209.nc atm/cam/topo/se/ne5pg3_nc3000_Co360_Fi001_MulG_PF_nullRR_Nsw064_20170516.nc atm/cam/topo/se/ne16pg3_nc3000_Co120_Fi001_PF_nullRR_Nsw084_20171012.nc -atm/cam/topo/se/ne30pg3_gmted2010_modis_bedmachine_nc3000_Laplace0100_20230105.nc +atm/cam/topo/se/ne30pg3_gmted2010_modis_bedmachine_nc3000_Laplace0100_noleak_20240117.nc atm/cam/topo/se/ne60pg3_nc3000_Co030_Fi001_PF_nullRR_Nsw021_20171012.nc atm/cam/topo/se/ne120pg3_nc3000_Co015_Fi001_PF_nullRR_Nsw010_20171014.nc atm/cam/topo/se/ne240pg3_nc3000_Co008_Fi001_PF_nullRR_Nsw005_20171015.nc -atm/cam/topo/se/ne5pg4_nc3000_Co360_Fi001_MulG_PF_nullRR_Nsw060_20170707.nc -atm/cam/topo/se/ne30pg4_nc3000_Co060_Fi001_PF_nullRR_Nsw042_20171014.nc -atm/cam/topo/se/ne60pg4_nc3000_Co030_Fi001_PF_nullRR_Nsw021_20171018.nc -atm/cam/topo/se/ne120pg4_nc3000_Co015_Fi001_PF_nullRR_Nsw010_20171014.nc - atm/cam/topo/se/ne30x8_CONUS_nc3000_Co060_Fi001_MulG_PF_RR_Nsw042_c200428.nc atm/cam/topo/se/ne30x4_ARCTIC_nc3000_Co060_Fi001_MulG_PF_RR_Nsw042_c200428.nc atm/cam/topo/se/ne30x8_ARCTICGRIS_nc3000_Co060_Fi001_MulG_PF_RR_Nsw042_c200428.nc atm/cam/topo/mpas/mpasa480_gmted2010_modis_bedmachine_nc3000_Laplace0400_noleak_20240507.nc atm/cam/topo/mpas/mpasa120_gmted2010_modis_bedmachine_nc3000_Laplace0100_noleak_20240507.nc + +atm/cam/topo/mpas_60_nc3000_Co030_Fi001_MulG_PF_Nsw021.nc + +atm/cam/topo/mpas_30_nc3000_Co015_Fi001_MulG_PF_Nsw011.nc + +atm/cam/topo/mpas_15_nc3500_c20230315.nc + + +atm/cam/topo/mpasa120_gmted2010_modis_bedmachine_nc3000_Laplace0100_20220728.nc + + 0.0D0 @@ -354,7 +375,7 @@ 98288.0D0 98288.0D0 98288.0D0 - 98288.0D0 + 98288.0D0 98288.0D0 98288.0D0 @@ -382,6 +403,8 @@ moist_baroclinic_wave_dcmip2016 moist_baroclinic_wave_dcmip2016 moist_baroclinic_wave_dcmip2016 + + us_standard_atmosphere @@ -579,7 +602,7 @@ atm/cam/physprops/mam4_mode4_rrtmg_c130628.nc atm/cam/physprops/mam4_mode1_rrtmg_aeronetdust_sig1.6_dgnh.48_c140304.nc -atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_sig1.2_dgnl.40_c150219.nc +atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_sig1.2_dgnl.40_c150219.nc atm/cam/physprops/mam4_mode1_rrtmg_aeronetdust_sig1.6_dgnh.48_c140304.nc atm/cam/physprops/mam4_mode2_rrtmg_aitkendust_c141106.nc @@ -599,7 +622,7 @@ .false. .true. -.true. +.true. slingo @@ -645,9 +668,9 @@ ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc -ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc +ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc -ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc +ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc waccm_ozone_c121126.nc 0 @@ -857,6 +880,7 @@ atm/waccm/gw/newmfspectra40_dc25.nc atm/waccm/gw/mfspectra_shallow_c140530.nc +atm/waccm/gw/mfc0lookup_mm.nc 0.25d0 0.5d0 0.5d0 @@ -886,8 +910,8 @@ .true. .true. .true. -.false. -.false. +.false. +.false. .false. .false. .false. @@ -907,6 +931,7 @@ 1.0d-3 0.002d0 0.1d0 + 0.01d0 15 @@ -944,6 +969,7 @@ atm/cam/coords/ne5np4_esmf_20191204.nc atm/cam/coords/ne5np4.pg3_esmf_mesh_c210121.nc atm/cam/coords/ne16np4_esmf_c210305.nc +share/meshes/ne16pg3_ESMFmesh_cdf5_c20211018.nc atm/cam/coords/ne30np4_esmf_c210305.nc atm/cam/coords/ne30pg3_esmf_20200428.nc @@ -955,10 +981,10 @@ 1.30D0 1.60D0 0.32D0 -1.50D0 -1.30D0 -1.60D0 -0.32D0 +1.50D0 +1.30D0 +1.60D0 +0.32D0 atm/cam/chem/trop_mozart/emis/megan21_emis_factors_78pft_c20161108.nc @@ -1942,10 +1968,10 @@ 1850 oxid_1.9x2.5_L26_1850clim_c091123.nc 1850 -oxid_1.9x2.5_L26_1850clim_c091123.nc -1850 -oxid_1.9x2.5_L26_1850clim_c091123.nc -1850 +oxid_1.9x2.5_L26_1850clim_c091123.nc +1850 +oxid_1.9x2.5_L26_1850clim_c091123.nc +1850 atm/cam/chem/trop_mozart_aero/oxid CYCLICAL @@ -1987,12 +2013,12 @@ atm/cam/ozone ozone_strataero_WACCM6_L70_zm5day_19750101-20141229_c180216.nc atm/cam/ozone_strataero -CESM_1849_2100_sad_V3_c160211.nc -atm/cam/volc -ozone_strataero_CAM6chem_1849-2014_zm_5day_c170924.nc -atm/cam/ozone -ozone_strataero_WACCM6_L70_zm5day_19750101-20141229_c180216.nc -atm/cam/ozone_strataero +CESM_1849_2100_sad_V3_c160211.nc +atm/cam/volc +ozone_strataero_CAM6chem_1849-2014_zm_5day_c170924.nc +atm/cam/ozone +ozone_strataero_WACCM6_L70_zm5day_19750101-20141229_c180216.nc +atm/cam/ozone_strataero atm/waccm/sulf/sulfate.ar5_camchem_c130304.nc @@ -2026,8 +2052,11 @@ atm/cam/chem/trop_mam/atmsrf_C192_c200625.nc atm/cam/chem/trop_mam/atmsrf_C384_c200625.nc -atm/cam/chem/trop_mam/atmsrf_mpasa120_c090720.nc atm/cam/chem/trop_mam/atmsrf_mpasa480_c090720.nc +atm/cam/chem/trop_mam/atmsrf_mpasa120_c090720.nc +atm/cam/chem/trop_mam/atmsrf_mpasa60_c210511.nc +atm/cam/chem/trop_mam/atmsrf_mpasa30_c210601.nc +atm/cam/chem/trop_mam/atmsrf_mpasa15_c20210804.nc atm/cam/chem/trop_mozart/dvel/regrid_vegetation.nc @@ -2074,7 +2103,7 @@ .true. .true. .false. - .false. + .false. .true. 0.075D0 @@ -2086,20 +2115,20 @@ .false. .true. - .true. + .true. .false. .true. .true. - .true. + .true. .true. 0 1 1 - 1 + 1 1 0.01d0 @@ -2128,6 +2157,7 @@ 2.4 + 5.0 1.0 1.0 0.7D0 @@ -2145,9 +2175,10 @@ 6.0 1.0 0.5 - 0.1 + 0.1 0.5 4.2 + 4.25 0.0 1.0 0.1 @@ -2164,35 +2195,44 @@ 1.25 0.25 0.3 - 0.1 + 0.1 0.3 0.0 0.4 25.0D-6 - 61.0D-6 + 61.0D-6 8.0D-6 238.15D0 .true. .false. 0.308 - 0.3 + 0.3 0.280 0.32 - 0.3 + 0.3 2 0.04 0.1 .false. + .false. + .true. + .false. .true. + .false. .false. .false. - .false. + .false. + .false. + .false. + .true. + .false. .false. .false. + .true. .false. .false. .false. - .true. + .true. .false. .false. .true. @@ -2204,17 +2244,23 @@ .true. .false. .false. - .true. + .true. + .false. .false. + .false. .false. .false. .true. - .true. - .true. + .false. + .true. + .true. + .true. + .true. .true. .false. .false. .true. + .true. .false. .false. .false. @@ -2230,9 +2276,12 @@ 1 2.0 60.0 + 0.5 + 25.0 .false. -.true. .true. +.true. + .true. 0.2 @@ -2258,6 +2307,7 @@ 10.0 4.0 0.0 + 5.0 .true. .false. @@ -2276,6 +2326,9 @@ .false. .false. .false. + 0.5 + 25.00 + .false. @@ -2284,6 +2337,15 @@ 0.22 10 + + + 10 + 10 + 10 + 10 + 10 + 10 + .false. .false. @@ -2338,15 +2400,14 @@ 1.D0 1.D0 - 0.375D0 1.D0 0.2D0 - 0.1D0 + 0.1D0 0.1D0 - 0.0D0 + 0.0D0 0.001D0 @@ -2365,10 +2426,10 @@ 1.D8 1.D8 - .true. - .true. - kk2000 - .true. + .true. + .true. + kk2000 + .true. 1 3 @@ -2401,17 +2462,17 @@ .false. .true. -.true. +.true. 0.01D0 0.05D0 .false. .true. -.true. +.true. .true. .false. -.false. +.false. 1.0D0 .true. @@ -2443,7 +2504,7 @@ 1.D0 0.D0 0.D0 -0.D0 +0.D0 1.D0 @@ -2453,12 +2514,12 @@ 30.D0 100.D0 100.D0 -100.D0 +100.D0 100.D3 100.D0 100.D0 -100.D0 +100.D0 30.D0 40.D0 @@ -2478,51 +2539,51 @@ 0.45D0 0.45D0 0.35D0 -0.35D0 +1.30D0 0.30D0 -0.30D0 +0.30D0 0.45D0 -0.45D0 +0.45D0 0.45D0 -0.45D0 +0.45D0 0.45D0 0.55D0 0.22D0 0.70D0 -0.80D0 +1.30D0 0.8D0 -0.8D0 +0.8D0 0.8D0 -0.8D0 +0.8D0 0.8D0 -0.8D0 +0.8D0 0.8D0 -0.8D0 +0.8D0 0.8D0 -0.8D0 +0.8D0 0.8D0 -0.8D0 +0.8D0 0.8D0 -0.8D0 +0.8D0 0.8D0 -0.8D0 +0.8D0 0.8D0 -0.8D0 +0.8D0 0.8D0 -0.8D0 +0.8D0 0.70D0 -0.70D0 +0.70D0 0.13D0 0.26D0 -0.26D0 +0.26D0 0.7D0 -0.7D0 +0.7D0 0.24D0 -0.24D0 +0.24D0 0.9D0 -0.9D0 +0.9D0 @@ -2530,7 +2591,7 @@ 1.62D0 0.90D0 1.00D0 -1.5D0 +1.5D0 1.10D0 1.2D0 0.60D0 @@ -2638,7 +2699,7 @@ .false. .true. .true. -.true. +.true. 0.900D0 0.910D0 @@ -2658,12 +2719,12 @@ 0.8875D0 0.9125D0 - 0.910D0 - 0.950D0 - 0.950D0 - 0.8975D0 - 0.8875D0 - 0.9125D0 + 0.910D0 + 0.950D0 + 0.950D0 + 0.8975D0 + 0.8875D0 + 0.9125D0 0.910D0 0.920D0 @@ -2677,7 +2738,7 @@ 0.100D0 0.000D0 - 0.000D0 + 0.000D0 0.000D0 0.800D0 @@ -2701,7 +2762,7 @@ 0.14D0 0.10D0 0.10D0 - 0.10D0 + 0.10D0 0.10D0 0.10D0 @@ -2726,25 +2787,25 @@ 750.0D2 700.0D2 700.0D2 - 700.0D2 + 700.0D2 1 5 5 - 5 + 5 4 4 4 - 4 + 4 0.95D0 0.93D0 0.93D0 - 0.93D0 + 0.93D0 0.70D0 0.70D0 0.70D0 - 0.70D0 + 0.70D0 0.80D0 0.85D0 @@ -2762,17 +2823,15 @@ 1.0D0 1.e-7 -5.e-6 5.e-3 .false. .false. .true. -.true. +.true. .false. -.true. 5.0e-6 @@ -2850,11 +2909,11 @@ 0.0035D0 0.0075D0 0.0075D0 - 0.0059D0 - 0.0035D0 - 0.0035D0 - 0.0075D0 - 0.0075D0 + 0.0059D0 + 0.0035D0 + 0.0035D0 + 0.0075D0 + 0.0075D0 0.0035D0 0.0035D0 0.0020D0 @@ -2871,11 +2930,11 @@ 0.0035D0 0.0300D0 0.0300D0 - 0.0450D0 - 0.0035D0 - 0.0035D0 - 0.0300D0 - 0.0300D0 + 0.0450D0 + 0.0035D0 + 0.0035D0 + 0.0300D0 + 0.0300D0 0.0035D0 0.0035D0 0.0020D0 @@ -2899,7 +2958,7 @@ 5 1 - 1 + 1 -1.0E-3 0.5 @@ -2921,7 +2980,7 @@ 2 4 4 - 4 + 4 4 42 42 @@ -2931,9 +2990,9 @@ 42 42 42 -42 +42 42 -42 +42 42 1 @@ -3081,9 +3140,9 @@ 3 3 5 - 5 + 5 6 - 6 + 6 1 1 3 @@ -3140,6 +3199,10 @@ 1 3 + + 0 + 1 + 2 .true. @@ -3149,15 +3212,21 @@ 3 2 4 - 4 + 9 + 8 + 2 + 3 3 1 - 1 - 20 - 4 - 2 - 4 + 1 + 3 + 2 + 4 + 20 + 4 + 2 + 4 1 2 @@ -3171,9 +3240,11 @@ 1.9 -1 +6.e15 5.e15 -1 +6.e15 10.e15 -1 @@ -3181,12 +3252,14 @@ 1.25e5 1.0e6 1.0e6 + 1.0e6 0.0 1.0 -1 -1 + 7.5 -1 1 @@ -3201,17 +3274,17 @@ 1 3 - 5 - 3 - 5 - 3 + 5 + 2 + 4 + 2 10 7 3 - 4 - 6 + 2 + 4 3 -1 @@ -3245,10 +3318,13 @@ SRK3 2 1800.0D0 - 900.0D0 + 600.0D0 600.D0 - 450.0D0 - 225.0D0 + 300.0D0 + 150.0D0 + 80.0D0 + 40.0D0 + 20.0D0 .true. 2 @@ -3266,6 +3342,9 @@ 120000.0D0 60000.0D0 30000.0D0 + 15000.0D0 + 7500.0D0 + 3750.0D0 0.05D0 10.0D0 @@ -3327,6 +3406,14 @@ 'SolIonRate_Tot = jeuv_1 + jeuv_2 + jeuv_3 + jeuv_4 + jeuv_5 + jeuv_6 + jeuv_7 + jeuv_8 + jeuv_9 + jeuv_10 + jeuv_11 + ', 'jeuv_14 + jeuv_15 + jeuv_16 + jeuv_17 + jeuv_18 + jeuv_19 + jeuv_20 + jeuv_21 + jeuv_22 + jeuv_23', + + 'SolIonRate_Tot = jeuv_1 + jeuv_2 + jeuv_3 + jeuv_4 + jeuv_5 + jeuv_6 + jeuv_7 + jeuv_8 + jeuv_9 + jeuv_10 + jeuv_11 + ', + 'jeuv_14 + jeuv_15 + jeuv_16 + jeuv_17 + jeuv_18 + jeuv_19 + jeuv_20 + jeuv_21 + jeuv_22 + jeuv_23', + + + 'SolIonRate_Tot = jeuv_1 + jeuv_2 + jeuv_3 + jeuv_4 + jeuv_5 + jeuv_6 + jeuv_7 + jeuv_8 + jeuv_9 + jeuv_10 + jeuv_11 + ', + 'jeuv_14 + jeuv_15 + jeuv_16 + jeuv_17 + jeuv_18 + jeuv_19 + jeuv_20 + jeuv_21 + jeuv_22 + jeuv_23', + 'O3_Prod = NO_HO2 + CH3O2_NO + HOCH2OO_NO + C2H5O2_NO + CH3CO3_NO + EO2_NO + C3H7O2_NO + PO2_NO + ', 'RO2_NO + ENEO2_NO + MACRO2_NOa + jhonitr + ', @@ -3438,6 +3525,35 @@ 'APIN_O3 + BPIN_O3 + LIMON_O3 + MYRC_O3 + ', 'ISOPN1D_O3 + ISOPN4D_O3 + ISOPNOOHD_O3 + NC4CHO_O3 + TERPF1_O3 + TERPF2_O3' + + 'O3_Prod = NO_HO2 + CH3O2_NO + C2H5O2_NO + CH3CO3_NO + EO2_NO + C3H7O2_NO + PO2_NO + RO2_NO + ', + ' MACRO2_NOa + MCO3_NO + .92*ISOPO2_NO + ISOPNO3_NO + XO2_NO + jnoa + jonitr + NOA_OH ', + 'O3_Loss = O1D_H2O + OH_O3 + HO2_O3 + C2H4_O3 + C3H6_O3 + ISOP_O3 + MVK_O3 + MACR_O3 + TERP_O3 + S_O3 + SO_O3', + 'O3S_Loss = 2.0*O_O3 + O1D_H2O + HO2_O3 + OH_O3 + H_O3 + 2.0*NO2_O + 2.0*jno3_b + 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa + ', + ' 2.0*CLO_CLOb + 2.0*BRO_CLOb + 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2 + S_O3 + SO_O3 + ', + ' C2H4_O3 + C3H6_O3 + ISOP_O3 + MVK_O3 + MACR_O3', + 'O3_alkenes = C2H4_O3 + C3H6_O3 + ISOP_O3 + MVK_O3 + MACR_O3', + 'RO2_NO_sum = CH3O2_NO + C2H5O2_NO + CH3CO3_NO + EO2_NO + C3H7O2_NO + PO2_NO + RO2_NO + MACRO2_NOa + ', + ' MACRO2_NOb + MCO3_NO + ISOPO2_NO + ISOPNO3_NO + XO2_NO', 'RO2_NO3_sum = MACRO2_NO3 + MCO3_NO3 + ISOPO2_NO3 + ISOPNO3_NO3 + XO2_NO3', + 'RO2_HO2_sum = CH3O2_HO2 + C2H5O2_HO2 + CH3CO3_HO2 + EO2_HO2 + C3H7O2_HO2 + PO2_HO2 + RO2_HO2 + MACRO2_HO2 + ', + ' MCO3_HO2 + ISOPO2_HO2 + ISOPNO3_HO2 + XO2_HO2', + 'RO2_RO2_sum = CH3O2_CH3O2a + CH3O2_CH3O2b + C2H5O2_CH3O2 + C2H5O2_C2H5O2 + CH3CO3_CH3O2 + CH3CO3_CH3CO3 + C3H7O2_CH3O2 + ', + ' RO2_CH3O2 + MACRO2_CH3O2 + MACRO2_CH3CO3 + MCO3_CH3O2 + MCO3_CH3CO3 + MCO3_MCO3 + ISOPO2_CH3O2 + ', + ' ISOPO2_CH3CO3 + XO2_CH3O2 + XO2_CH3CO3', + 'RCO2_NO2_sum = CH3CO3_NO2 + MCO3_NO2', + 'OddOx_Ox_Loss = 2.0*O_O3 + O1D_H2O', + 'OddOx_HOx_Loss = HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3', + 'OddOx_NOx_Loss = 2.0*NO2_O + 2.0*jno3_b', + 'OddOx_CLOxBROx_Loss = 2.0*CLO_O + 2.0*jcl2o2 + 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb + 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Loss_Tot = 2.0*O_O3 + O1D_H2O + HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3 + 2.0*NO2_O + 2.0*jno3_b + 2.0*CLO_O + 2.0*jcl2o2 + ', + ' 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb + 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2', + 'OddOx_Prod_Tot = 2.0*jo2_a + 2.0*jo2_b', + 'Ox_Prod = 2.0*jo2_a + 2.0*jo2_b + NO_HO2 + CH3O2_NO + C2H5O2_NO + CH3CO3_NO + EO2_NO + C3H7O2_NO + PO2_NO + ', + ' RO2_NO + MACRO2_NOa + MCO3_NO + .92*ISOPO2_NO + ISOPNO3_NO + XO2_NO + jnoa + jonitr + NOA_OH', + 'Ox_Loss = 2.0*O_O3 + O1D_H2O + HO2_O + HO2_O3 + OH_O + OH_O3 + H_O3 + 2.0*NO2_O + 2.0*jno3_b + 2.0*CLO_O + 2.0*jcl2o2 + ', + ' 2.0*CLO_CLOa + 2.0*CLO_CLOb + 2.0*BRO_CLOb + 2.0*BRO_CLOc + 2.0*BRO_BRO + 2.0*BRO_O + CLO_HO2 + BRO_HO2 + C2H4_O3 + ', + ' C3H6_O3 + ISOP_O3 + MVK_O3 + MACR_O3 + TERP_O3 + S_O3 + SO_O3' + 'O3_Prod = NO_HO2 + CH3O2_NO + HOCH2OO_NO + C2H5O2_NO + CH3CO3_NO + EO2_NO + C3H7O2_NO + PO2_NO + RO2_NO + ENEO2_NO + ', ' MACRO2_NOa + MCO3_NO + MEKO2_NO + ALKO2_NO + .92*ISOPAO2_NO + .92*ISOPBO2_NO + ISOPNO3_NO + XO2_NO + ACBZO2_NO + ', diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 9d7c323b59..e0c4b46778 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -1332,6 +1332,12 @@ Whether or not to enable gravity waves produced by shallow convection. Default: .false. + +Whether or not to enable gravity waves from PBL moving mountains source. +Default: .false. + + Gravity wave spectrum dimension (wave numbers are from -pgwv to pgwv). @@ -1533,6 +1539,13 @@ Width of gaussian used to create frontogenesis tau profile [m/s]. Default: set by build-namelist. + +Tunable parameter controlling proportion of boundary layer momentum flux escaping as GW momentum flux +Default: set by build-namelist. + + + Full pathname of Beres lookup table data file for gravity waves sourced @@ -1547,6 +1560,12 @@ from shallow convection. Default: set by build-namelist. + +Relative pathname of lookup table for deep convective moving mountain GW source +Default: set by build-namelist. + + Background source strength (used for waves from frontogenesis). @@ -3605,7 +3624,9 @@ Default: set by build-namelist -Switch for CLUBB_SGS +Flag for CLUBB_SGS. N.B. this variable may not be set by the user. It is +set by build-namelist via information in the configure cache file to be +consistent with how CAM was built. Default: set by build-namelist @@ -3771,6 +3792,11 @@ air is supersaturated with respect to ice. Plume widths for theta_l and rt + +E-folding parameter for mixed Brunt Vaisala Frequency + + Limiting value of C1 when skewness of w (vertical velocity) is small in @@ -4010,6 +4036,15 @@ Gaussian PDF, and also decreases the difference between the means of w from each Gaussian. + +Selected option for the two-component normal (double Gaussian) PDF type to use for the w, rt, +and theta-l (or w, chi, and eta) portion of CLUBB's multivariate, two-component PDF. +iiPDF_ADG1 = 1 (ADG1 PDF), iiPDF_ADG2 = 2 (ADG2 PDF), iiPDF_3D_Luhar = 3 (3D Luhar PDF), +iiPDF_new = 4 (new PDF), iiPDF_TSDADG = 5 (TSDADG PDF), iiPDF_LY93 = 6 (Lewellen and Yoh (1993)), +iiPDF_new_hybrid = 7 (new hybrid PDF) + + Option for the placement of the call to CLUBB's PDF closure. The options include: ipdf_pre_advance_fields (1) calls the PDF closure before advancing prognostic fields. ipdf_post_advance_fields (2) calls after advancing prognostic fields, and ipdf_pre_post_advance_fields (3) calls both before and after advancing prognostic fields. @@ -4033,6 +4068,22 @@ Flag to uses an alternate equation to calculate the Brunt-Vaisala frequency. This equation calculates an in-cloud Brunt-Vaisala frequency. + +Flag to use cloud fraction to adjust the value of the +turbulent dissipation coefficient, C2. + + + +Include the contribution of radiation to thlp2 + + + +Calculate the correlations between w and the hydrometeors + + Flag to call CLUBB's PDF closure at both thermodynamic and momentum vertical @@ -4040,6 +4091,11 @@ grid levels. When this flag is turned off, CLUBB's PDF closure is only called on thermodynamic grid levels. + +Use a constant cloud droplet conc. within cloud + + Flag to use a dissipation formula of -(2/3)*em/tau_zm, as in Bougeault (1981), @@ -4061,6 +4117,17 @@ is turned off, Lscale is calculated first, and then dissipation time-scale tau is calculated as tau = Lscale / sqrt(tke). + +Diagnose correlations instead of using fixed ones + + + +Implicit diffusion on moisture and temperature, implemented within CLUBB's +matrix equations for wprtp/rtm and wpthlp/thlm. + + Explicit diffusion on temperature and moisture by CLUBB, in addition to CLUBB's @@ -4077,6 +4144,11 @@ Flag to run CLUBB with E3SM settings. Flag to relax clipping on wpxp in xm_wpxp_clipping_and_stats. + +Use a fixed correlation for s and t Mellor(chi/eta) + + This flag determines whether we want to use an upwind differencing approximation @@ -4171,6 +4243,11 @@ horizontal winds um and vm. When this flag is turned off, upwp and vpwp are calculated by down-gradient diffusion. + +used in adj_low_res_nu. If .true., avg_deltaz = deltaz + + Flag to take any remaining supersaturation after CLUBB PDF call and add it to @@ -4180,6 +4257,11 @@ levels and the momentum grid levels and variables are interpolated between the two grid level types. + +Turn on (true) and off (false) rtm nudging. + + Flag to use smooth Heaviside 'Peskin' in computation of invrs_tau. @@ -4192,6 +4274,11 @@ Use the standard discretization for the turbulent advection terms. Setting to advance_wp2_wp3_module.F90 and in advance_xp2_xpyp_module.F90. + +Whether or not we want CLUBB to apply a stability correction Kh_N2_zm. + + Flag to use a stability corrected version of CLUBB's time scale (tau_zm). This @@ -4199,6 +4286,13 @@ creates a time scale that provides stronger damping at altitudes where Brunt-Vaisala frequency is large. + +Use anisotropic turbulent kinetic energy in the CLUBB higher order closure, i.e. +calculate TKE = 1/2 (u'^2 + v'^2 + w'^2). This improves the simulation of complex +turbulence but at a greater cost than running without. + + Flag that uses the trapezoidal rule to adjust fields calculated by CLUBB's PDF @@ -4215,6 +4309,13 @@ adjacent vertical grid level. The clubb_l_trapezoidal_rule_zt flag applies this adjustment to PDF fields calculated on thermodynamic vertical grid levels. + +This flag determines whether we want to use an upwind differencing approximation +rather than a centered differencing for turbulent or mean advection terms. It +affects rtm, thlm, sclrm, um and vm. + + Flag to use "upwind" discretization in the turbulent advection term in the @@ -4224,6 +4325,11 @@ potential temperature). When this flag is turned off, centered discretization is used. + +Turn on (true) or off (false) uv wind speed nudging. + + Flag to calculate the value of CLUBB's C11 based on Richardson number, where @@ -4246,6 +4352,13 @@ levels influence the amount of cloudiness and amount of cloud water in a grid box. + +Flag to use precipitation fraction in KK microphysics. The +precipitation fraction is automatically set to 1 when this +flag is turned off. + + Flag to use shear in the calculation of Richardson number. @@ -4331,6 +4444,16 @@ clubb_up2_sfc_coef increases the values of up2 and vp2 at the surface. CLUBB tunable parameter - Lscale threshold: damp C6 and C7 (units: m) + +Exponent for Richardson number in calculation of invrs_tau_wpxp term + + + +Displacement of log law profile above ground (units: m) + + @@ -8255,6 +8378,20 @@ Default: Set by build-namelist. Default: Set by build-namelist. + + + 0: physics tendencies will be added every vertical remapping time-step (dt_phys/se_nsplit) + for se_ftype=0,2 + + 1: physics tendencies will be added every dynamics time-step (dt_phys/se_nsplit*se_rsplit) + for se_ftype=0,2 + + If se_ftype=1 then se_dribble_in_rsplit_loop has no effect since physics tendencies are added as an adjustment + + Default: Set by build-namelist. + + diff --git a/bld/namelist_files/use_cases/aquaplanet_cam5.xml b/bld/namelist_files/use_cases/aquaplanet_cam5.xml index 814eecd98f..f5a3ed7988 100644 --- a/bld/namelist_files/use_cases/aquaplanet_cam5.xml +++ b/bld/namelist_files/use_cases/aquaplanet_cam5.xml @@ -18,9 +18,7 @@ 348.0e-6 -atm/cam/solar/ape_solar_ave_tsi_1365.nc -.true. -/ +atm/cam/solar/ape_solar_ave_tsi_1365.nc apeozone_cam3_5_54.nc diff --git a/bld/namelist_files/use_cases/aquaplanet_cam6.xml b/bld/namelist_files/use_cases/aquaplanet_cam6.xml index 814eecd98f..f5a3ed7988 100644 --- a/bld/namelist_files/use_cases/aquaplanet_cam6.xml +++ b/bld/namelist_files/use_cases/aquaplanet_cam6.xml @@ -18,9 +18,7 @@ 348.0e-6 -atm/cam/solar/ape_solar_ave_tsi_1365.nc -.true. -/ +atm/cam/solar/ape_solar_ave_tsi_1365.nc apeozone_cam3_5_54.nc diff --git a/bld/namelist_files/use_cases/aquaplanet_rce_cam6.xml b/bld/namelist_files/use_cases/aquaplanet_rce_cam6.xml index f03c4294b2..7b93fa8418 100644 --- a/bld/namelist_files/use_cases/aquaplanet_rce_cam6.xml +++ b/bld/namelist_files/use_cases/aquaplanet_rce_cam6.xml @@ -1,8 +1,9 @@ - - + + atm/cam/inic/se/initial_data.cam.ne30.L32.RCEMIP_c20190507.nc + 0. 0. @@ -12,18 +13,6 @@ false - atm/cam/ozone/ - ozone.cam.ne30.L32.RCEMIP_c20190507.nc - atm/cam/inic/se/initial_data.cam.ne30.L32.RCEMIP_c20190507.nc - atm/cam/solar/solar_tsi_551_with_ssi.cam.ne30.L32.RCEMIP_c20190507.nc - .false. - - true - I - 1 - 1 - 'T','Q','U','V','PS','PRECT','Z3' - 1.650e-6 0.306e-6 @@ -32,13 +21,12 @@ 0.0 0.0 - -atm/cam/solar/ape_solar_ave_tsi_1365.nc -.true. -/ + + atm/cam/solar/solar_tsi_551_with_ssi.cam.ne30.L32.RCEMIP_c20190507.nc + .false. - -apeozone_cam3_5_54.nc + + ozone.cam.ne30.L32.RCEMIP_c20190507.nc atm/cam/ozone OZONE CYCLICAL @@ -48,7 +36,6 @@ .true. 0.73391095 - 0.0 86164.10063718943 @@ -67,4 +54,10 @@ "" 0.0 + true + I + 1 + 1 + 'T','Q','U','V','PS','PRECT','Z3' + diff --git a/bld/namelist_files/use_cases/hist_trop_strat_ts4_cam7.xml b/bld/namelist_files/use_cases/hist_trop_strat_ts4_cam7.xml new file mode 100644 index 0000000000..4e65f4f34c --- /dev/null +++ b/bld/namelist_files/use_cases/hist_trop_strat_ts4_cam7.xml @@ -0,0 +1,32 @@ + + + + + +atm/cam/inic/se/f.cam6_3_153.FCMTnudged_climate_chemistry_ne30.factor_fix.cam.i.1996-01-01-00000_c220522.nc + + +atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc +SERIAL + + +SERIAL + +INTERP_MISSING_MONTHS + +INTERP_MISSING_MONTHS + + +SERIAL +atm/waccm/lb/LBC_17500116-25001216_CMIP6_SSP585_0p5degLat_c20200824.nc + + 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', + 'HCFC22', 'N2O', 'CFC114', 'CFC115', 'HCFC141B', 'HCFC142B', 'H2402', 'OCS', 'SF6', 'CFC11eq' + + + +.true. +.false. +.false. + + diff --git a/bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml b/bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml index 6b56c46b17..f380c36d60 100644 --- a/bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml +++ b/bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml @@ -135,4 +135,9 @@ .false. .false. + + 'SolIonRate_Tot = jeuv_1 + jeuv_2 + jeuv_3 + jeuv_4 + jeuv_5 + jeuv_6 + jeuv_7 + jeuv_8 + jeuv_9 + jeuv_10 + jeuv_11 + jeuv_14 + jeuv_15 + jeuv_16 +', + 'jeuv_17 + jeuv_18 + jeuv_19 + jeuv_20 + jeuv_21 + jeuv_22 + jeuv_23', + + diff --git a/bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml b/bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml index 5658d9cb1d..d40cc385f4 100644 --- a/bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml +++ b/bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml @@ -112,7 +112,6 @@ 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jhocl', 'jno3_b', 'jcl2o2', 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE','AOA1','AOA2', 'O2', 'CLDLIQ', 'CLDICE', 'ASDIR', - 'VTHzm', 'WTHzm', 'UVzm', 'UWzm', 'TH', 'MSKtem', 'O2_1S', 'O2_1D', 'Op', 'O2p', 'Np', 'NOp', 'N2p', 'e', 'UIONTEND', 'VIONTEND', 'UTGWSPEC', 'UTGWORO', 'VTGWSPEC', 'VTGWORO', 'TTGW', diff --git a/bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml b/bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml index c928b43f28..cc6eea7802 100644 --- a/bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml +++ b/bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml @@ -93,7 +93,7 @@ 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN' - + 'MSKtem', 'PS', 'PSL', 'VTHzm', 'UVzm', 'UWzm', 'Uzm', 'Vzm', 'THzm','Wzm', 'PHIS' diff --git a/ccs_config b/ccs_config new file mode 160000 index 0000000000..69a958581e --- /dev/null +++ b/ccs_config @@ -0,0 +1 @@ +Subproject commit 69a958581ecd2d32ee9cb1c38bcd3847b8b920bf diff --git a/chem_proc b/chem_proc new file mode 160000 index 0000000000..f923081508 --- /dev/null +++ b/chem_proc @@ -0,0 +1 @@ +Subproject commit f923081508f4264e61fcef2753a9898e55d1598e diff --git a/cime b/cime new file mode 160000 index 0000000000..fcb9c6ec1e --- /dev/null +++ b/cime @@ -0,0 +1 @@ +Subproject commit fcb9c6ec1e15f2f33995cf247aef3f8ef9f121eb diff --git a/cime_config/SystemTests/mgp.py b/cime_config/SystemTests/mgp.py index 14f691dfcf..ab2232eda0 100644 --- a/cime_config/SystemTests/mgp.py +++ b/cime_config/SystemTests/mgp.py @@ -2,7 +2,7 @@ CIME MGP test. This class inherits from SystemTestsCompareTwo This is a changing config options test to compare between MG3 and -PUMAS in camdev. The use of MG3 or PUMAS should be bfb. +PUMAS in cam7. The use of MG3 or PUMAS should be bfb. This is just like an ERC test and it's meant for CAM only as it only does a single build. @@ -39,9 +39,9 @@ def __init__(self, case, def _case_one_setup(self): stop_n = self._case1.get_value("STOP_N") expect(stop_n >= 3, "STOP_N must be at least 3, STOP_N = {}".format(stop_n)) - self._case.set_value("CAM_CONFIG_OPTS","-phys cam_dev -microphys mg3") + self._case.set_value("CAM_CONFIG_OPTS","-phys cam7 -microphys mg3") def _case_two_setup(self): - self._case.set_value("CAM_CONFIG_OPTS","-phys cam_dev -microphys pumas") + self._case.set_value("CAM_CONFIG_OPTS","-phys cam7 -microphys pumas") diff --git a/cime_config/SystemTests/sct.py b/cime_config/SystemTests/sct.py index bc11add267..23108fc3a5 100644 --- a/cime_config/SystemTests/sct.py +++ b/cime_config/SystemTests/sct.py @@ -79,3 +79,13 @@ def _component_compare_test(self, suffix1, suffix2, self._test_status.set_status("{}_{}_{}".format(COMPARE_PHASE, self._run_one_suffix, self._run_two_suffix), TEST_FAIL_STATUS) comments="QDIFF,TDIFF: Difference greater than round off." append_testlog(comments, self._orig_caseroot) + + def _case_two_custom_prerun_action(self): + """ On NCAR derecho system the mpibind script causes ESMF in the second job to think it is using 128 tasks when it should only use 1 + changing the env variable PBS_SELECT solves this issue + """ + machine = self._case2.get_value("MACH") + if "derecho" in machine: + os.environ["PBS_SELECT"] = "1:ncpus=1:mpiprocs=1:ompthreads=1:mem=230gb:Qlist=cpu:ngpus=0" + + diff --git a/cime_config/SystemTests/tmc.py b/cime_config/SystemTests/tmc.py index 9fb8a5f7ab..ba92070de9 100644 --- a/cime_config/SystemTests/tmc.py +++ b/cime_config/SystemTests/tmc.py @@ -25,7 +25,7 @@ def run_phase(self): self.run_indv() cpllog = ''.join(get_latest_cpl_logs(self._case)) atmlog = cpllog.replace("cpl.log","atm.log") - atmlog = atmlog.replace("drv.log","atm.log") + atmlog = atmlog.replace("med.log","atm.log") if '.gz' == atmlog[-3:]: fopen = gzip.open else: diff --git a/cime_config/buildcpp b/cime_config/buildcpp index e7df81cecb..5bbcf7d851 100644 --- a/cime_config/buildcpp +++ b/cime_config/buildcpp @@ -15,7 +15,7 @@ sys.path.append(os.path.join(CIMEROOT, "CIME", "Tools")) from standard_script_setup import * -from CIME.utils import run_cmd_no_fail +from CIME.utils import run_cmd from CIME.case import Case from CIME.buildnml import parse_input @@ -73,15 +73,6 @@ def buildcpp(case): case.set_value("EPS_AAREA", "1.0e-04") case.set_value("EPS_AGRID", "1.0e-05") - # The vector mapping (in the mediator) needs to be 'cart3d' for SE - # NB: This is currently the default, is it working by conincidence for - # other unstructured dycores? - # For cmeps/nuopc cart3d is always the default option for all grids - match = re.match(r'ne[0-9]', atm_grid) - if match: - if (comp_interface == 'mct'): - case.set_value('VECT_MAP', 'cart3d') - # if need to build - then construct configure command config_opts = ["-s", "-fc_type", compiler, "-dyn", cam_dycore, "-hgrid", atm_grid, "-cpl", comp_interface, @@ -136,7 +127,10 @@ def buildcpp(case): srcroot = testpath cmd = os.path.join(srcroot, "bld", "configure") + \ " " + " ".join(config_opts) - run_cmd_no_fail(cmd, from_dir=camconf) + + stat, output, err = run_cmd(cmd, from_dir=camconf) + if stat: + logger.warning(err) # determine cppdefs - caseroot/camconf/CESM_cppdefs is created by the call to configure with open(os.path.join(camconf, "CESM_cppdefs"), 'r') as f: diff --git a/cime_config/buildlib b/cime_config/buildlib index 73db5db3dd..0328e84f2f 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -6,7 +6,7 @@ create the cam library # pylint: disable=multiple-imports, wrong-import-position, wildcard-import # pylint: disable=unused-wildcard-import, bad-whitespace, too-many-locals # pylint: disable=invalid-name -import sys, os, filecmp, shutil, imp +import sys, os, filecmp, shutil _CIMEROOT = os.environ.get("CIMEROOT") @@ -19,11 +19,56 @@ sys.path.append(_LIBDIR) from standard_script_setup import * from CIME.case import Case from CIME.utils import run_sub_or_cmd, expect, run_cmd +from CIME.utils import import_from_file from CIME.buildlib import parse_input from CIME.build import get_standard_makefile_args logger = logging.getLogger(__name__) +############################################################################### +def _build_fms(caseroot, libroot, bldroot): + ############################################################################### + + with Case(caseroot) as case: + + # Only need FMS for fv3 dycore + cam_dycore = case.get_value("CAM_DYCORE") + srcroot = case.get_value("SRCROOT") + if cam_dycore == "fv3": + # first check for the external FMS library and build it + # Check to see if some other component built it already + fmsbuildlib = os.path.join(srcroot, "libraries", "FMS", "buildlib") + librootfms = os.path.join(libroot, "libfms.a") + if not os.path.exists(librootfms): + if case.get_value("DEBUG"): + strdebug = "debug" + else: + strdebug = "nodebug" + + if case.get_value("BUILD_THREADED"): + strthread = "threads" + else: + strthread = "nothreads" + + mpilib = case.get_value("MPILIB") + sharedpath = os.path.join(case.get_value("COMPILER"), mpilib, + strdebug, strthread) + slr = os.path.abspath(case.get_value("SHAREDLIBROOT")) + fmsbuildroot = os.path.join(slr, sharedpath) + fmsinstallpath = os.path.join(fmsbuildroot, "FMS") + install_libfms = os.path.join(fmsinstallpath, "libfms.a") + + if not os.path.exists(install_libfms): + if not os.path.exists(fmsbuildlib): + #todo: call checkout_externals to get this component + expect(False, "FMS external not found") + else: + stat, _, err = run_cmd(f"{fmsbuildlib} {fmsbuildroot} {fmsinstallpath} {caseroot}", verbose=True) + expect(stat==0, f"FMS build Failed {err}") + + if os.path.exists(install_libfms): + shutil.copy(install_libfms, libroot) + ############################################################################### def _build_cam(caseroot, libroot, bldroot): ############################################################################### @@ -41,10 +86,10 @@ def _build_cam(caseroot, libroot, bldroot): cmd = os.path.join(os.path.join(srcroot, "cime_config", "buildcpp")) logger.info(" ...calling cam buildcpp to set build time options") try: - mod = imp.load_source("buildcpp", cmd) - cam_cppdefs = mod.buildcpp(case) + buildcpp = import_from_file("buildcpp", cmd) + cam_cppdefs = buildcpp.buildcpp(case) except: - raise + raise RuntimeError("CAM's 'buildcpp' script failed to run properly.") with Case(caseroot) as case: @@ -63,12 +108,11 @@ def _build_cam(caseroot, libroot, bldroot): threaded = "threads" if case.get_value("BUILD_THREADED") or case.get_value("FORCE_BUILD_SMP") else "nothreads" comp_interface = case.get_value("COMP_INTERFACE") fmsbuilddir = os.path.join( - slr, compiler, mpilib, debug, threaded, comp_interface) + slr, compiler, mpilib, debug, threaded, "FMS") user_incldir = '"-I{} -I{} -I{}"'.format( os.path.join(srcroot, "libraries", "FMS", "src", "include"), os.path.join(srcroot, "libraries", "FMS", "src", "mpp", "include"), - fmsbuilddir, - ) + fmsbuilddir) # ------------------------------------------------------- # Filepath is created in caseroot/camconf by the call @@ -119,6 +163,7 @@ def _build_cam(caseroot, libroot, bldroot): def _main_func(): caseroot, libroot, bldroot = parse_input(sys.argv) + _build_fms(caseroot, libroot, bldroot) _build_cam(caseroot, libroot, bldroot) diff --git a/cime_config/buildnml b/cime_config/buildnml index 0af683719a..a077e13fcd 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -4,7 +4,7 @@ CAM namelist creator """ # pylint: disable=multiple-imports -import sys, os, shutil, filecmp, imp +import sys, os, shutil, filecmp _CIMEROOT = os.environ.get("CIMEROOT") if _CIMEROOT is None: @@ -19,7 +19,7 @@ from standard_script_setup import * from CIME.XML.standard_module_setup import * from CIME.buildnml import create_namelist_infile, parse_input from CIME.case import Case -from CIME.utils import expect, run_cmd +from CIME.utils import expect, run_cmd, import_from_file logger = logging.getLogger(__name__) @@ -75,10 +75,10 @@ def buildnml(case, caseroot, compname): cmd = os.path.join(os.path.join(srcroot,"cime_config","buildcpp")) logger.info(" ...calling cam buildcpp to set build time options") try: - mod = imp.load_source("buildcpp", cmd) - mod.buildcpp(case) + buildcpp = import_from_file("buildcpp", cmd) + _ = buildcpp.buildcpp(case) except: - raise + raise RuntimeError("CAM's 'buildcpp' script failed to run properly.") # Verify that we have a config_cache file (generated by the call to buildcpp) expect(os.path.isfile(filename), @@ -173,7 +173,7 @@ def buildnml(case, caseroot, compname): buildnl_opts += ["-inputdata", input_data_list] - CAM_NAMELIST_OPTS += " stream_ndep_year_first=" + stream_ndep_year_first + CAM_NAMELIST_OPTS += " stream_ndep_year_first=" + stream_ndep_year_first CAM_NAMELIST_OPTS += " stream_ndep_year_last=" + stream_ndep_year_last CAM_NAMELIST_OPTS += " stream_ndep_year_align=" + stream_ndep_year_align CAM_NAMELIST_OPTS += " stream_ndep_data_filename='" + stream_ndep_data_filename.strip() + "'" @@ -216,13 +216,15 @@ def buildnml(case, caseroot, compname): # copy geos-chem config files to rundir if using geos-chem chemistry # ----------------------------------------------------- - if os.path.isdir(rundir) and '-chem geoschem' in CAM_CONFIG_OPTS: - for fname in ['species_database.yml', 'geoschem_config.yml', - 'HISTORY.rc', 'HEMCO_Config.rc', 'HEMCO_Diagn.rc']: - file1 = os.path.join(caseroot, fname) - file2 = os.path.join(rundir, fname) - logger.info("GEOS-Chem config file copy: file1 %s file2 %s ", file1, file2) - shutil.copy(file1,file2) + if os.path.isdir(rundir) \ + and os.path.exists(os.path.join(caseroot, "species_database.yml"))\ + and '-chem geoschem' in CAM_CONFIG_OPTS: + for fname in ['species_database.yml', 'geoschem_config.yml', + 'HISTORY.rc', 'HEMCO_Config.rc', 'HEMCO_Diagn.rc']: + file1 = os.path.join(caseroot, fname) + file2 = os.path.join(rundir, fname) + logger.info("GEOS-Chem config file copy: file1 %s file2 %s ", file1, file2) + shutil.copy(file1,file2) ############################################################################### def _main_func(): diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 21d3ec6d4b..94dd4ff76d 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -8,12 +8,12 @@ CAM =============== --> - CAM cam6 physics: + CAM cam7 physics: + CAM cam6 physics: CAM cam5 physics: CAM cam4 physics: CAM cam3 physics: CAM simplified and non-versioned physics : - CAM7 development physics: CAM-Chem troposphere/stratosphere chemistry with simplified VBS-SOA: CAM-Chem troposphere/stratosphere chemistry with simplified VBS-SOA and expanded isoprene and terpene oxidation: + CAM-Chem troposphere/stratosphere simplified chemistry for climate simulations: GEOS-Chem troposphere/stratosphere chemistry : CAM-Chem troposphere/stratosphere chem with simplified volatility basis set SOA scheme and fire emissons : CAM CLUBB - turned on by default in CAM60: CAM-Chem troposphere/stratosphere chem with extended volatility basis set SOA scheme and modal aersols : CAM low top model - Prognostic GHG chemistry mechanism for CAM7: Modal Aerosol Model composed of 7 modes: CAM mid top model CAM CO2 ramp: @@ -134,16 +134,16 @@ -phys cam4 -phys cam5 -phys cam6 + -phys cam7 - -phys cam_dev - -chem ghg_mam4 -chem trop_strat_mam5_vbs -chem geoschem_mam4 -chem trop_mam7 -chem trop_strat_mam5_vbsext -chem trop_strat_mam5_ts2 + -chem trop_strat_mam5_ts4 -clubb_sgs -dyn eul -scam -rad camrt -chem none -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_sam1mom @@ -175,8 +175,8 @@ -nlev 56 -nlev 88 -nlev 145 - -nlev 58 -model_top lt - -nlev 93 -model_top mt + -nlev 58 -model_top lt + -nlev 93 -model_top mt -phys adiabatic @@ -189,6 +189,7 @@ -aquaplanet -aquaplanet + -analytic_ic -offline_drv rad @@ -217,14 +218,14 @@ waccm_tsmlt_1850_cam6 waccm_ma_1850_cam6 waccm_sc_1850_cam6 - 1850_cam_lt - 1850_cam_mt + 1850_cam_lt + 1850_cam_mt 2000_cam4_trop_chem waccmxie_ma_2000_cam4 waccmx_ma_2000_cam4 - 2000_cam6 + 2000_cam6 2000_cam6 waccm_tsmlt_2000_cam6 waccm_ma_2000_cam6 @@ -257,14 +258,15 @@ 1950-2010_ccmi_refc1_waccmx_ma 1850-2005_cam5 hist_cam6 - hist_cam_lt - hist_cam_mt + hist_cam_lt + hist_cam_mt waccm_tsmlt_hist_cam6 waccm_sc_hist_cam6 waccm_ma_hist_cam6 waccm_ma_hist_cam6 waccm_ma_hist_cam4 hist_trop_strat_vbs_cam6 + hist_trop_strat_ts4_cam7 hist_trop_strat_nudged_cam6 hist_trop_strat_vbsext_cam6 hist_trop_strat_vbsfire_cam6 diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index d2aec47d2e..002e8b184f 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -63,22 +63,22 @@ FLTHIST - HIST_CAM%DEV%LT%GHGMAM4_CLM51%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + HIST_CAM70%LT_CLM60%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV FMTHIST - HIST_CAM%DEV%MT%GHGMAM4_CLM51%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + HIST_CAM70%MT_CLM60%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV FLT1850_TESTINGONLY_v0c - 1850_CAM%DEV%LT%GHGMAM4_CLM51%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + 1850_CAM70%LT_CLM60%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV FMT1850_TESTINGONLY_v0c - 1850_CAM%DEV%MT%GHGMAM4_CLM51%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + 1850_CAM70%MT_CLM60%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV @@ -282,7 +282,7 @@ F2000dev - 2000_CAM%DEV_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + 2000_CAM70_CLM60%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV @@ -344,11 +344,15 @@ FCLTHIST - HIST_CAM%DEV%LT%CCTS1_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + HIST_CAM70%LT%CCTS1_CLM60%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV FCMTHIST - HIST_CAM%DEV%MT%CCTS1_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + HIST_CAM70%MT%CCTS1_CLM60%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + + FCts4MTHIST + HIST_CAM70%MT%CCTS4_CLM60%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV FCvbsxHIST diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml index 5b4bc10c5b..c074a75baf 100644 --- a/cime_config/config_pes.xml +++ b/cime_config/config_pes.xml @@ -432,7 +432,7 @@ 1 - + none -8 @@ -455,7 +455,7 @@ - + none -8 @@ -482,7 +482,7 @@ 0 - + none -12 @@ -540,7 +540,7 @@ - + none 1800 @@ -1790,14 +1790,14 @@ none - 128 - 128 - 128 - 128 - 128 - 128 - 128 - 128 + -3 + -3 + -3 + -3 + -3 + -3 + -3 + -3 1 diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 62cd0af626..2e9445c61e 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -5,7 +5,7 @@ - + @@ -17,7 +17,7 @@ - + @@ -25,7 +25,7 @@ - + @@ -33,7 +33,7 @@ - + @@ -42,7 +42,7 @@ - + @@ -50,7 +50,7 @@ - + @@ -58,7 +58,7 @@ - + @@ -67,7 +67,7 @@ - + @@ -77,7 +77,7 @@ - + @@ -87,17 +87,17 @@ - + - + - + @@ -109,7 +109,7 @@ - + @@ -123,7 +123,7 @@ - + @@ -131,7 +131,7 @@ - + @@ -139,7 +139,7 @@ - + @@ -148,7 +148,7 @@ - + @@ -158,7 +158,7 @@ - + @@ -168,7 +168,7 @@ - + @@ -181,7 +181,7 @@ - + @@ -191,7 +191,7 @@ - + @@ -199,7 +199,7 @@ - + @@ -207,7 +207,7 @@ - + @@ -224,7 +224,7 @@ - + @@ -232,7 +232,7 @@ - + @@ -240,7 +240,7 @@ - + @@ -248,13 +248,13 @@ - + - + @@ -262,17 +262,17 @@ - + - + - + @@ -280,7 +280,7 @@ - + @@ -288,7 +288,7 @@ - + @@ -297,16 +297,18 @@ - + + + - + @@ -314,7 +316,7 @@ - + @@ -325,7 +327,7 @@ - + @@ -335,7 +337,7 @@ - + @@ -345,9 +347,10 @@ - + + @@ -355,7 +358,7 @@ - + @@ -365,7 +368,7 @@ - + @@ -375,7 +378,7 @@ - + @@ -385,7 +388,7 @@ - + @@ -395,7 +398,7 @@ - + @@ -405,7 +408,7 @@ - + @@ -415,9 +418,10 @@ - + + @@ -425,7 +429,7 @@ - + @@ -435,7 +439,7 @@ - + @@ -445,7 +449,7 @@ - + @@ -455,7 +459,7 @@ - + @@ -465,7 +469,7 @@ - + @@ -475,7 +479,7 @@ - + @@ -485,7 +489,7 @@ - + @@ -495,9 +499,10 @@ - + + @@ -505,7 +510,7 @@ - + @@ -515,7 +520,7 @@ - + @@ -525,7 +530,7 @@ - + @@ -535,7 +540,7 @@ - + @@ -545,7 +550,7 @@ - + @@ -555,7 +560,7 @@ - + @@ -564,7 +569,7 @@ - + @@ -572,7 +577,7 @@ - + @@ -581,7 +586,7 @@ - + @@ -589,7 +594,7 @@ - + @@ -598,7 +603,7 @@ - + @@ -608,7 +613,7 @@ - + @@ -618,7 +623,7 @@ - + @@ -630,7 +635,7 @@ - + @@ -641,7 +646,7 @@ - + @@ -652,7 +657,7 @@ - + @@ -663,7 +668,7 @@ - + @@ -674,7 +679,7 @@ - + @@ -685,7 +690,7 @@ - + @@ -696,7 +701,7 @@ - + @@ -707,7 +712,7 @@ - + @@ -718,7 +723,7 @@ - + @@ -743,7 +748,7 @@ - + @@ -754,7 +759,7 @@ - + @@ -765,7 +770,7 @@ - + @@ -776,7 +781,7 @@ - + @@ -786,7 +791,7 @@ - + @@ -795,7 +800,7 @@ - + @@ -805,7 +810,7 @@ - + @@ -815,7 +820,7 @@ - + @@ -825,7 +830,7 @@ - + @@ -835,7 +840,7 @@ - + @@ -845,7 +850,7 @@ - + @@ -855,7 +860,7 @@ - + @@ -865,7 +870,7 @@ - + @@ -875,7 +880,7 @@ - + @@ -885,7 +890,7 @@ - + @@ -895,7 +900,7 @@ - + @@ -905,7 +910,7 @@ - + @@ -916,7 +921,7 @@ - + @@ -926,7 +931,7 @@ - + @@ -935,7 +940,7 @@ - + @@ -943,7 +948,7 @@ - + @@ -951,7 +956,7 @@ - + @@ -961,7 +966,7 @@ - + @@ -971,7 +976,7 @@ - + @@ -981,7 +986,7 @@ - + @@ -991,7 +996,7 @@ - + @@ -1001,7 +1006,7 @@ - + @@ -1011,7 +1016,7 @@ - + @@ -1021,7 +1026,7 @@ - + @@ -1031,7 +1036,7 @@ - + @@ -1041,7 +1046,7 @@ - + @@ -1051,7 +1056,7 @@ - + @@ -1061,7 +1066,7 @@ - + @@ -1071,7 +1076,7 @@ - + @@ -1081,7 +1086,7 @@ - + @@ -1091,7 +1096,7 @@ - + @@ -1101,7 +1106,7 @@ - + @@ -1111,7 +1116,7 @@ - + @@ -1121,7 +1126,7 @@ - + @@ -1131,7 +1136,7 @@ - + @@ -1141,7 +1146,7 @@ - + @@ -1151,7 +1156,7 @@ - + @@ -1161,7 +1166,7 @@ - + @@ -1170,7 +1175,7 @@ - + @@ -1180,7 +1185,7 @@ - + @@ -1190,7 +1195,7 @@ - + @@ -1200,7 +1205,7 @@ - + @@ -1210,7 +1215,7 @@ - + @@ -1220,7 +1225,7 @@ - + @@ -1231,7 +1236,7 @@ - + @@ -1240,7 +1245,7 @@ - + @@ -1249,7 +1254,7 @@ - + @@ -1259,7 +1264,7 @@ - + @@ -1269,7 +1274,7 @@ - + @@ -1279,7 +1284,7 @@ - + @@ -1289,7 +1294,7 @@ - + @@ -1298,7 +1303,7 @@ - + @@ -1306,7 +1311,7 @@ - + @@ -1315,7 +1320,7 @@ - + @@ -1325,7 +1330,7 @@ - + @@ -1335,7 +1340,7 @@ - + @@ -1345,9 +1350,10 @@ - + + @@ -1355,7 +1361,7 @@ - + @@ -1364,7 +1370,7 @@ - + @@ -1373,7 +1379,7 @@ - + @@ -1382,7 +1388,7 @@ - + @@ -1403,48 +1409,43 @@ - + - + - + - + - + - + - + - - - - - - + @@ -1455,7 +1456,7 @@ - + @@ -1464,7 +1465,7 @@ - + @@ -1479,127 +1480,87 @@ - + - - - + + - + - - + + - + + - - + - + - - + - + - + - - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - + - + + - + - - + - + - + - - + - - - - + - - + - - - - + @@ -1607,7 +1568,7 @@ - + @@ -1615,7 +1576,7 @@ - + @@ -1623,7 +1584,7 @@ - + @@ -1631,7 +1592,7 @@ - + @@ -1639,7 +1600,7 @@ - + @@ -1647,7 +1608,7 @@ - + @@ -1655,7 +1616,7 @@ - + @@ -1664,16 +1625,16 @@ - + - + - + @@ -1683,7 +1644,7 @@ - + @@ -1694,7 +1655,7 @@ - + @@ -1704,7 +1665,7 @@ - + @@ -1714,7 +1675,7 @@ - + @@ -1724,7 +1685,7 @@ - + @@ -1734,7 +1695,7 @@ - + @@ -1745,7 +1706,7 @@ - + @@ -1755,7 +1716,7 @@ - + @@ -1764,7 +1725,7 @@ - + @@ -1773,7 +1734,7 @@ - + @@ -1788,7 +1749,7 @@ - + @@ -1797,7 +1758,7 @@ - + @@ -1805,8 +1766,8 @@ - - + + @@ -1815,7 +1776,7 @@ - + @@ -1824,7 +1785,7 @@ - + @@ -1833,10 +1794,10 @@ - + - + @@ -1845,7 +1806,7 @@ - + @@ -1854,7 +1815,7 @@ - + @@ -1862,7 +1823,7 @@ - + @@ -1871,7 +1832,7 @@ - + @@ -1880,7 +1841,7 @@ - + @@ -1889,12 +1850,12 @@ - + - + @@ -1903,23 +1864,23 @@ - + - + - + - + @@ -1928,12 +1889,30 @@ - + + + + + + + + + + + + + + + + + + + - + @@ -1952,7 +1931,7 @@ - + @@ -1962,7 +1941,7 @@ - + @@ -1972,17 +1951,17 @@ - + - + - + @@ -1993,7 +1972,7 @@ - + @@ -2003,7 +1982,7 @@ - + @@ -2012,7 +1991,7 @@ - + @@ -2024,13 +2003,13 @@ - + - + @@ -2039,7 +2018,7 @@ - + @@ -2047,7 +2026,7 @@ - + @@ -2055,17 +2034,17 @@ - + - + - + @@ -2074,7 +2053,7 @@ - + @@ -2083,7 +2062,7 @@ - + @@ -2092,12 +2071,12 @@ - + - + @@ -2107,7 +2086,7 @@ - + @@ -2117,7 +2096,7 @@ - + @@ -2125,7 +2104,7 @@ - + @@ -2133,7 +2112,7 @@ - + @@ -2142,7 +2121,7 @@ - + @@ -2151,7 +2130,7 @@ - + @@ -2160,7 +2139,7 @@ - + @@ -2170,7 +2149,7 @@ - + @@ -2178,7 +2157,7 @@ - + @@ -2187,7 +2166,7 @@ - + @@ -2197,17 +2176,17 @@ - + - + - + @@ -2216,7 +2195,7 @@ - + @@ -2225,7 +2204,7 @@ - + @@ -2235,7 +2214,7 @@ - + @@ -2244,12 +2223,12 @@ - + - + @@ -2258,26 +2237,45 @@ - + - + - + - + - + + + + + + + + + + + + + + + + + + + + @@ -2287,7 +2285,7 @@ - + @@ -2296,7 +2294,7 @@ - + @@ -2305,7 +2303,7 @@ - + @@ -2314,7 +2312,7 @@ - + @@ -2323,7 +2321,7 @@ - + @@ -2331,7 +2329,7 @@ - + @@ -2339,7 +2337,7 @@ - + @@ -2347,7 +2345,7 @@ - + @@ -2355,7 +2353,7 @@ - + @@ -2364,12 +2362,12 @@ - + - + @@ -2378,7 +2376,7 @@ - + @@ -2387,7 +2385,7 @@ - + @@ -2395,15 +2393,15 @@ - + - + - + @@ -2412,7 +2410,7 @@ - + @@ -2420,7 +2418,7 @@ - + @@ -2429,59 +2427,69 @@ - + - + - + - + - + + + + + - + - + + + + + + + - + - + - + - + @@ -2490,12 +2498,12 @@ - + - + @@ -2503,7 +2511,7 @@ - + @@ -2511,22 +2519,22 @@ - + - + - + - + @@ -2534,7 +2542,7 @@ - + @@ -2542,7 +2550,7 @@ - + @@ -2550,7 +2558,7 @@ - + @@ -2559,7 +2567,7 @@ - + @@ -2567,7 +2575,7 @@ - + @@ -2575,32 +2583,32 @@ - + - + - + - + - + - + @@ -2610,7 +2618,7 @@ - + @@ -2618,7 +2626,7 @@ - + @@ -2627,7 +2635,7 @@ - + @@ -2635,7 +2643,7 @@ - + @@ -2644,7 +2652,7 @@ - + @@ -2652,7 +2660,7 @@ - + @@ -2661,22 +2669,22 @@ - + - + - + - + @@ -2685,17 +2693,17 @@ - + - + - + @@ -2704,7 +2712,7 @@ - + @@ -2713,12 +2721,12 @@ - + - + @@ -2727,7 +2735,7 @@ - + @@ -2737,7 +2745,7 @@ - + @@ -2746,13 +2754,13 @@ - + - + @@ -2761,17 +2769,17 @@ - + - + - + @@ -2785,11 +2793,11 @@ - + - + @@ -2797,13 +2805,13 @@ - + - + @@ -2813,7 +2821,7 @@ - + @@ -2823,7 +2831,7 @@ - + @@ -2833,7 +2841,7 @@ - + @@ -2843,7 +2851,7 @@ - + @@ -2852,13 +2860,13 @@ - + - + @@ -2867,7 +2875,7 @@ - + @@ -2887,20 +2895,20 @@ - + - + - + @@ -2914,7 +2922,7 @@ - + diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam7/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam7/shell_commands new file mode 100644 index 0000000000..d3fa399380 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam7/shell_commands @@ -0,0 +1,3 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange RUN_STARTDATE=0001-12-14 +./xmlchange CAM_CONFIG_OPTS="-phys cam7 -microphys mg2 -chem ghg_mam4 -nlev 32" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam_dev/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam7/user_nl_cam similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam_dev/user_nl_cam rename to cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam7/user_nl_cam diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam_dev/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam7/user_nl_clm similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam_dev/user_nl_clm rename to cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam7/user_nl_clm diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam_dev/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam_dev/shell_commands deleted file mode 100644 index 513b5dbe41..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam_dev/shell_commands +++ /dev/null @@ -1,3 +0,0 @@ -./xmlchange ROF_NCPL=\$ATM_NCPL -./xmlchange RUN_STARTDATE=0001-12-14 -./xmlchange CAM_CONFIG_OPTS="-phys cam_dev -microphys mg2 -chem ghg_mam4 -nlev 32" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg2_default/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg2_default/shell_commands deleted file mode 100644 index 89516e5375..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg2_default/shell_commands +++ /dev/null @@ -1,7 +0,0 @@ -./xmlchange NTASKS=36 -./xmlchange NTHRDS=1 -./xmlchange ROOTPE='0' -./xmlchange ROF_NCPL=`./xmlquery --value ATM_NCPL` -./xmlchange GLC_NCPL=`./xmlquery --value ATM_NCPL` -./xmlchange TIMER_DETAIL='6' -./xmlchange TIMER_LEVEL='999' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3/shell_commands index dec26a5365..35e44ac120 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3/shell_commands @@ -2,5 +2,5 @@ ./xmlchange GLC_NCPL=\$ATM_NCPL ./xmlchange CAM_CONFIG_OPTS=' -microphys mg3' --append if [ "`./xmlquery ATM_GRID --value`" == "C96" ]; then - ./xmlchange NTASKS=-2 + ./xmlchange NTASKS=-3 fi diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3/user_nl_cam index 8482082dce..a8572b28a8 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3/user_nl_cam @@ -2,3 +2,82 @@ mfilt=1,1,1,1,1,1 ndens=1,1,1,1,1,1 nhtfrq=9,9,9,9,9,9 inithist='ENDOFRUN' +clubb_history = .true. +clubb_rad_history = .false. +fincl1 = 'Q', 'RHW', 'QRS', 'QRL', 'HR', 'FDL', +'thlm', 'thvm', 'rtm', 'rcm', 'rvm', 'um', 'vm', 'um_ref','vm_ref','ug', 'vg', 'cloud_frac', 'cloud_cover', +'rcm_in_layer', 'rcm_in_cloud', 'p_in_Pa', 'exner', 'rho_ds_zt', 'thv_ds_zt', 'Lscale', 'Lscale_pert_1', +'Lscale_pert_2', 'T_in_K', 'rel_humidity', 'wp3', 'wpthlp2', 'wp2thlp', 'wprtp2', 'wp2rtp', 'Lscale_up', +'Lscale_down', 'tau_zt', 'Kh_zt', 'wp2thvp', 'wp2rcp', 'wprtpthlp', 'sigma_sqd_w_zt', 'rho', 'radht', +'radht_LW', 'radht_SW', 'Ncm', 'Nc_in_cloud', 'Nc_activated', 'snowslope', 'sed_rcm', 'rsat', 'rsati', +'diam', 'mass_ice_cryst', 'rcm_icedfs', 'u_T_cm', 'rtm_bt', 'rtm_ma', 'rtm_ta', 'rtm_mfl', 'thlm_tacl', +'thlm_cl', 'thlm_forcing', 'thlm_sdmp','thlm_mc', 'thlm_old', 'thlm_without_ta', 'thlm_mfl_min', +'thlm_mfl_max', 'thlm_enter_mfl', 'thlm_exit_mfl', 'rtm_old', 'rtm_without_ta', 'rtm_mfl_min', 'rtm_mfl_max', +'rtm_enter_mfl', 'rtm_exit_mfl', 'um_bt', 'um_ma', 'um_gf', 'um_cf', 'um_ta', 'um_f', 'um_sdmp', 'um_ndg', +'vm_bt', 'vm_ma', 'vm_gf', 'vm_cf', 'vm_ta', 'vm_f', 'vm_sdmp', 'vm_ndg', 'wp3_bt', 'wp3_ma', 'wp3_ta', +'wp3_tp', 'wp3_ac', 'wp3_bp1', 'wp3_pr_turb', 'wp3_pr_dfsn', 'wp3_pr1', 'wp3_pr2', 'wp3_dp1', 'wp3_cl', +'mixt_frac', 'w_1', 'w_2', 'varnce_w_1', 'varnce_w_2', 'thl_1', 'thl_2', 'varnce_thl_1', 'varnce_thl_2', +'rt_1', 'rt_2', 'varnce_rt_1', 'varnce_rt_2', 'rc_1', 'rc_2', 'rsatl_1', 'rsatl_2', 'cloud_frac_1', +'cloud_frac_2', 'a3_coef_zt', 'wp3_on_wp2_zt', 'chi_1', 'chi_2', 'stdev_chi_1', 'stdev_chi_2', +'stdev_eta_1', 'stdev_eta_2', 'covar_chi_eta_1', 'covar_chi_eta_2', 'corr_chi_eta_1', 'corr_chi_eta_2', +'corr_rt_thl_1', 'crt_1', 'crt_2', 'cthl_1', 'cthl_2', 'precip_frac', 'precip_frac_1', 'precip_frac_2', +'Ncnm', 'wp2_zt', 'thlp2_zt', 'wpthlp_zt', 'wprtp_zt', 'rtp2_zt', 'rtpthlp_zt', 'up2_zt', 'vp2_zt', +'upwp_zt', 'vpwp_zt', 'C11_Skw_fnc', 'wp2', 'rtp2', 'thlp2', 'rtpthlp', 'wprtp', 'wpthlp', 'wp4', 'up2', +'vp2', 'wpthvp', 'rtpthvp', 'thlpthvp', 'tau_zm', 'Kh_zm', 'wprcp', 'wm_zm', 'thlprcp', 'rtprcp', 'rcp2', +'upwp', 'vpwp', 'rho_zm', 'sigma_sqd_w', 'Skw_velocity', 'gamma_Skw_fnc', 'C6rt_Skw_fnc', 'C6thl_Skw_fnc', +'C7_Skw_fnc', 'C1_Skw_fnc', 'a3_coef', 'wp3_on_wp2', 'rcm_zm', 'rtm_zm', 'thlm_zm', 'cloud_frac_zm', +'rho_ds_zm', 'thv_ds_zm', 'em', 'mean_w_up', 'mean_w_down', 'shear', 'wp3_zm', 'Frad', 'Frad_LW', 'Frad_SW', +'Frad_LW_up', 'Frad_SW_up', 'Frad_LW_down', 'Frad_SW_down', 'Fprec', 'Fcsed', 'wp2_bt', 'wp2_ma', 'wp2_ta', +'wp2_ac', 'wp2_bp', 'wp2_pr1', 'wp2_pr2', 'wp2_pr3', 'wp2_dp1', 'wp2_dp2', 'wp2_cl', 'wp2_pd', 'wp2_sf', +'vp2_bt', 'vp2_ma', 'vp2_ta', 'vp2_tp', 'vp2_dp1', 'vp2_dp2', 'vp2_pr1', 'vp2_pr2', 'vp2_cl', 'vp2_pd', +'vp2_sf', 'up2_bt', 'up2_ma', 'up2_ta', 'up2_tp', 'up2_dp1', 'up2_dp2', 'up2_pr1', 'up2_pr2', 'up2_cl', +'up2_pd', 'up2_sf', 'wprtp_bt', 'wprtp_ma', 'wprtp_ta', 'wprtp_tp', 'wprtp_ac', 'wprtp_bp', 'wprtp_pr1', +'wprtp_pr2', 'wprtp_pr3', 'wprtp_dp1', 'wprtp_mfl', 'wprtp_cl', 'wprtp_sicl', 'wprtp_pd', 'wprtp_forcing', +'wprtp_mc', 'wpthlp_bt', 'wpthlp_ma', 'wpthlp_ta', 'wpthlp_tp', 'wpthlp_ac', 'wpthlp_bp', 'wpthlp_pr1', +'wpthlp_pr2', 'wpthlp_pr3', 'wpthlp_dp1', 'wpthlp_mfl', 'wpthlp_cl', 'wpthlp_sicl', 'wpthlp_forcing', +'wpthlp_mc', 'rtp2_bt', 'rtp2_ma', 'rtp2_ta', 'rtp2_tp', 'rtp2_dp1', 'rtp2_dp2', 'rtp2_cl', 'rtp2_pd', +'rtp2_sf', 'rtp2_forcing', 'rtp2_mc', 'thlp2_bt', 'thlp2_ma', 'thlp2_ta', 'thlp2_tp', 'thlp2_dp1', +'thlp2_dp2', 'thlp2_cl', 'thlp2_pd', 'thlp2_sf', 'thlp2_forcing', 'thlp2_mc', 'rtpthlp_bt', 'rtpthlp_ma', +'rtpthlp_ta', 'rtpthlp_tp1', 'rtpthlp_tp2', 'rtpthlp_dp1', 'rtpthlp_dp2', 'rtpthlp_cl', 'rtpthlp_sf', +'rtpthlp_forcing', 'rtpthlp_mc', 'wpthlp_enter_mfl', 'wpthlp_exit_mfl', 'wprtp_enter_mfl', 'wprtp_exit_mfl', +'wpthlp_mfl_min', 'wpthlp_mfl_max', 'wprtp_mfl_min', 'wprtp_mfl_max', 'shear_sqd' + +clubb_vars_zt ='thlm', 'thvm', 'rtm', 'rcm', 'rvm', 'um', 'vm', 'um_ref','vm_ref','ug', 'vg', 'cloud_frac', +'cloud_cover', 'rcm_in_layer', 'rcm_in_cloud', 'p_in_Pa', 'exner', 'rho_ds_zt', 'thv_ds_zt', 'Lscale', +'Lscale_pert_1', 'Lscale_pert_2', 'T_in_K', 'rel_humidity', 'wp3', 'wpthlp2', 'wp2thlp', 'wprtp2', 'wp2rtp', +'Lscale_up', 'Lscale_down', 'tau_zt', 'Kh_zt', 'wp2thvp', 'wp2rcp', 'wprtpthlp', 'sigma_sqd_w_zt', 'rho', +'radht', 'radht_LW', 'radht_SW', 'Ncm', 'Nc_in_cloud', 'Nc_activated', 'snowslope', 'sed_rcm', 'rsat', +'rsati', 'diam', 'mass_ice_cryst', 'rcm_icedfs', 'u_T_cm', 'rtm_bt', 'rtm_ma', 'rtm_ta', 'rtm_mfl', +'rtm_tacl', 'rtm_cl', 'rtm_forcing', 'rtm_sdmp','rtm_mc', 'rtm_pd', 'rvm_mc', 'rcm_mc', 'rcm_sd_mg_morr', +'thlm_bt', 'thlm_ma', 'thlm_ta', 'thlm_mfl', 'thlm_tacl', 'thlm_cl', 'thlm_forcing', 'thlm_sdmp','thlm_mc', +'thlm_old', 'thlm_without_ta', 'thlm_mfl_min', 'thlm_mfl_max', 'thlm_enter_mfl', 'thlm_exit_mfl', +'rtm_old', 'rtm_without_ta', 'rtm_mfl_min', 'rtm_mfl_max', 'rtm_enter_mfl', 'rtm_exit_mfl', 'um_bt', +'um_ma', 'um_gf', 'um_cf', 'um_ta', 'um_f', 'um_sdmp', 'um_ndg', 'vm_bt', 'vm_ma', 'vm_gf', 'vm_cf', +'vm_ta', 'vm_f', 'vm_sdmp', 'vm_ndg', 'wp3_bt', 'wp3_ma', 'wp3_ta', 'wp3_tp', 'wp3_ac', 'wp3_bp1', +'wp3_pr_turb', 'wp3_pr_dfsn', 'wp3_pr1', 'wp3_pr2', 'wp3_dp1', 'wp3_cl', 'mixt_frac', 'w_1', 'w_2', +'varnce_w_1', 'varnce_w_2', 'thl_1', 'thl_2', 'varnce_thl_1', 'varnce_thl_2', 'rt_1', +'rt_2', 'varnce_rt_1', 'varnce_rt_2', 'rc_1', 'rc_2', 'rsatl_1', 'rsatl_2', 'cloud_frac_1', 'cloud_frac_2', +'a3_coef_zt', 'wp3_on_wp2_zt', 'chi_1', 'chi_2', 'stdev_chi_1', 'stdev_chi_2', 'stdev_eta_1', 'stdev_eta_2', +'covar_chi_eta_1', 'covar_chi_eta_2', 'corr_chi_eta_1', 'corr_chi_eta_2', 'corr_rt_thl_1', 'crt_1', +'crt_2', 'cthl_1', 'cthl_2', 'precip_frac', 'precip_frac_1', 'precip_frac_2', 'Ncnm', 'wp2_zt', 'thlp2_zt', +'wpthlp_zt', 'wprtp_zt', 'rtp2_zt', 'rtpthlp_zt', 'up2_zt', 'vp2_zt', 'upwp_zt', 'vpwp_zt', 'C11_Skw_fnc' + +clubb_vars_zm= 'wp2', 'rtp2', 'thlp2', 'rtpthlp', 'wprtp', 'wpthlp', 'wp4', 'up2', 'vp2', 'wpthvp', +'rtpthvp', 'thlpthvp', 'tau_zm', 'Kh_zm', 'wprcp', 'wm_zm', 'thlprcp', 'rtprcp', 'rcp2', 'upwp', 'vpwp', +'rho_zm', 'sigma_sqd_w', 'Skw_velocity', 'gamma_Skw_fnc', 'C6rt_Skw_fnc', 'C6thl_Skw_fnc', 'C7_Skw_fnc', +'C1_Skw_fnc', 'a3_coef', 'wp3_on_wp2', 'rcm_zm', 'rtm_zm', 'thlm_zm', 'cloud_frac_zm', 'rho_ds_zm', +'thv_ds_zm', 'em', 'mean_w_up', 'mean_w_down', 'shear', 'wp3_zm', 'Frad', 'Frad_LW', 'Frad_SW', +'Frad_LW_up', 'Frad_SW_up', 'Frad_LW_down', 'Frad_SW_down', 'Fprec', 'Fcsed', 'wp2_bt', 'wp2_ma', 'wp2_ta', +'wp2_ac', 'wp2_bp', 'wp2_pr1', 'wp2_pr2', 'wp2_pr3', 'wp2_dp1', 'wp2_dp2', 'wp2_cl', 'wp2_pd', 'wp2_sf', +'vp2_bt', 'vp2_ma', 'vp2_ta', 'vp2_tp', 'vp2_dp1', 'vp2_dp2', 'vp2_pr1', 'vp2_pr2', 'vp2_cl', 'vp2_pd', 'vp2_sf', 'up2_bt', 'up2_ma', 'up2_ta', 'up2_tp', 'up2_dp1', 'up2_dp2', 'up2_pr1', 'up2_pr2', 'up2_cl', 'up2_pd', +'up2_sf', 'wprtp_bt', 'wprtp_ma', 'wprtp_ta', 'wprtp_tp', 'wprtp_ac', 'wprtp_bp', 'wprtp_pr1', 'wprtp_pr2', +'wprtp_pr3', 'wprtp_dp1', 'wprtp_mfl', 'wprtp_cl', 'wprtp_sicl', 'wprtp_pd', 'wprtp_forcing', 'wprtp_mc', +'wpthlp_bt', 'wpthlp_ma', 'wpthlp_ta', 'wpthlp_tp', 'wpthlp_ac', 'wpthlp_bp', 'wpthlp_pr1', 'wpthlp_pr2', +'wpthlp_pr3', 'wpthlp_dp1', 'wpthlp_mfl', 'wpthlp_cl', 'wpthlp_sicl', 'wpthlp_forcing', 'wpthlp_mc', +'rtp2_bt', 'rtp2_ma', 'rtp2_ta', 'rtp2_tp', 'rtp2_dp1', 'rtp2_dp2', 'rtp2_cl', 'rtp2_pd', 'rtp2_sf', +'rtp2_forcing', 'rtp2_mc', 'thlp2_bt', 'thlp2_ma', 'thlp2_ta', 'thlp2_tp', 'thlp2_dp1', 'thlp2_dp2', +'thlp2_cl', 'thlp2_pd', 'thlp2_sf', 'thlp2_forcing', 'thlp2_mc', 'rtpthlp_bt', 'rtpthlp_ma', 'rtpthlp_ta', +'rtpthlp_tp1', 'rtpthlp_tp2', 'rtpthlp_dp1', 'rtpthlp_dp2', 'rtpthlp_cl', 'rtpthlp_sf', 'rtpthlp_forcing', +'rtpthlp_mc', 'wpthlp_enter_mfl', 'wpthlp_exit_mfl', 'wprtp_enter_mfl', 'wprtp_exit_mfl', 'wpthlp_mfl_min', +'wpthlp_mfl_max', 'wprtp_mfl_min', 'wprtp_mfl_max', 'shear_sqd' + diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_default/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_default/shell_commands index 9fdcee8bfd..23dac55242 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_default/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_default/shell_commands @@ -1,4 +1,4 @@ -./xmlchange NTASKS=36 +./xmlchange NTASKS=128 ./xmlchange NTHRDS=1 ./xmlchange ROOTPE='0' ./xmlchange ROF_NCPL=`./xmlquery --value ATM_NCPL` diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_nondefault/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_nondefault/shell_commands deleted file mode 100644 index 9fdcee8bfd..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_nondefault/shell_commands +++ /dev/null @@ -1,8 +0,0 @@ -./xmlchange NTASKS=36 -./xmlchange NTHRDS=1 -./xmlchange ROOTPE='0' -./xmlchange ROF_NCPL=`./xmlquery --value ATM_NCPL` -./xmlchange GLC_NCPL=`./xmlquery --value ATM_NCPL` -./xmlchange CAM_CONFIG_OPTS=' -microphys mg3' --append -./xmlchange TIMER_DETAIL='6' -./xmlchange TIMER_LEVEL='999' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_nondefault/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_nondefault/user_nl_cam deleted file mode 100644 index 8bb09f9ffc..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_nondefault/user_nl_cam +++ /dev/null @@ -1,24 +0,0 @@ -mfilt=1,1,1,1,1,1 -ndens=1,1,1,1,1,1 -nhtfrq=9,9,9,9,9,9 -inithist='ENDOFRUN' -micro_mg_do_graupel=.false. -micro_mg_do_hail=.true. -micro_do_sb_physics=.true. -micro_do_massless_droplet_destroyer=.true. -microp_uniform=.true. -micro_mg_nccons=.true. -micro_mg_nicons=.true. -micro_mg_ngcons=.true. -micro_mg_nrcons=.true. -micro_mg_nscons=.true. -micro_mg_evap_sed_off=.true. -micro_mg_icenuc_rh_off=.true. -micro_mg_icenuc_use_meyers=.true. -micro_mg_evap_scl_ifs=.true. -micro_mg_evap_rhthrsh_ifs=.true. -micro_mg_rainfreeze_ifs=.true. -micro_mg_ifs_sed=.true. -micro_mg_precip_fall_corr=.true. -micro_mg_implicit_fall=.false. -micro_mg_accre_sees_auto=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/user_nl_clm deleted file mode 100644 index 12d5a36d2b..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/user_nl_clm +++ /dev/null @@ -1,26 +0,0 @@ -!---------------------------------------------------------------------------------- -! Users should add all user specific namelist changes below in the form of -! namelist_var = new_namelist_value -! -! Include namelist variables for drv_flds_in ONLY if -megan and/or -drydep options -! are set in the CLM_NAMELIST_OPTS env variable. -! -! EXCEPTIONS: -! Set use_cndv by the compset you use and the CLM_BLDNML_OPTS -dynamic_vegetation setting -! Set use_vichydro by the compset you use and the CLM_BLDNML_OPTS -vichydro setting -! Set use_cn by the compset you use and CLM_BLDNML_OPTS -bgc setting -! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting -! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup setting -! Set irrigate by the CLM_BLDNML_OPTS -irrig setting -! Set dtime with L_NCPL option -! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options -! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases -! (includes $inst_string for multi-ensemble cases) -! Set glc_grid with CISM_GRID option -! Set glc_smb with GLC_SMB option -! Set maxpatch_glcmec with GLC_NEC option -! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable -!---------------------------------------------------------------------------------- -hist_nhtfrq = 9 -hist_mfilt = 1 -hist_ndens = 1 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760/shell_commands similarity index 70% rename from cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/shell_commands rename to cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760/shell_commands index d6e6750eb4..f9424e5025 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760/shell_commands @@ -1,8 +1,8 @@ -./xmlchange NTASKS=36 +./xmlchange NTASKS=64 ./xmlchange NTHRDS=1 ./xmlchange ROOTPE='0' ./xmlchange ROF_NCPL=`./xmlquery --value ATM_NCPL` ./xmlchange GLC_NCPL=`./xmlquery --value ATM_NCPL` -./xmlchange CAM_CONFIG_OPTS=' -microphys mg3 -pcols 1536' --append +./xmlchange CAM_CONFIG_OPTS=' -microphys mg3 -pcols 760 ' --append ./xmlchange TIMER_DETAIL='6' ./xmlchange TIMER_LEVEL='999' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg2_default/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760/user_nl_cam similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg2_default/user_nl_cam rename to cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760/user_nl_cam diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg2_default/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760/user_nl_clm similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg2_default/user_nl_clm rename to cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760/user_nl_clm diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_rainbows/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_rainbows/shell_commands new file mode 100644 index 0000000000..d10bce4cdc --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_rainbows/shell_commands @@ -0,0 +1,3 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL +./xmlchange CAM_CONFIG_OPTS=' -microphys pumas' --append diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_rainbows/user_nl_cam similarity index 68% rename from cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/user_nl_cam rename to cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_rainbows/user_nl_cam index 8482082dce..936d79412d 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_rainbows/user_nl_cam @@ -2,3 +2,4 @@ mfilt=1,1,1,1,1,1 ndens=1,1,1,1,1,1 nhtfrq=9,9,9,9,9,9 inithist='ENDOFRUN' +fincl1 = 'RBFRAC','RBFREQ','rbSZA' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_nondefault/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_rainbows/user_nl_clm similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_nondefault/user_nl_clm rename to cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_rainbows/user_nl_clm diff --git a/cime_config/testdefs/testmods_dirs/cam/silhs/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/silhs/user_nl_cam index d322c3706a..13ceac46c1 100644 --- a/cime_config/testdefs/testmods_dirs/cam/silhs/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/silhs/user_nl_cam @@ -46,7 +46,7 @@ fincl1 = 'U:A','PS:A','T:A','V:A','OMEGA:A','Z3:A','PRECT:A', 'rtp2_dp2', 'rtp2_cl', 'rtp2_pd', 'rtp2_sf', 'rtp2_forcing', 'rtp2_mc', 'thlp2_bt', 'thlp2_ma', 'thlp2_ta', 'thlp2_tp', 'thlp2_dp1', 'thlp2_dp2', 'thlp2_cl', 'thlp2_pd', 'thlp2_sf', 'thlp2_forcing', 'thlp2_mc', 'rtpthlp_bt', 'rtpthlp_ma', 'rtpthlp_ta', 'rtpthlp_tp1', 'rtpthlp_tp2', 'rtpthlp_dp1', 'rtpthlp_dp2', 'rtpthlp_cl', 'rtpthlp_sf', 'rtpthlp_forcing', 'rtpthlp_mc', 'wpthlp_enter_mfl', 'wpthlp_exit_mfl', 'wprtp_enter_mfl', 'wprtp_exit_mfl', 'wpthlp_mfl_min', -'wpthlp_mfl_max', 'wprtp_mfl_min', 'wprtp_mfl_max', 'Richardson_num', 'shear_sqd', +'wpthlp_mfl_max', 'wprtp_mfl_min', 'wprtp_mfl_max', 'shear_sqd' fincl2 = 'CLDTOT', 'CLDST','CDNUMC','CLDLIQ','CLDICE','FLUT', 'LWCF','SWCF','PRECT' clubb_history = .true. @@ -77,4 +77,4 @@ clubb_vars_zm= 'wp2', 'rtp2', 'thlp2', 'rtpthlp', 'wprtp', 'wpthlp', 'wp4', 'up2 'rtp2_dp2', 'rtp2_cl', 'rtp2_pd', 'rtp2_sf', 'rtp2_forcing', 'rtp2_mc', 'thlp2_bt', 'thlp2_ma', 'thlp2_ta', 'thlp2_tp', 'thlp2_dp1', 'thlp2_dp2', 'thlp2_cl', 'thlp2_pd', 'thlp2_sf', 'thlp2_forcing', 'thlp2_mc', 'rtpthlp_bt', 'rtpthlp_ma', 'rtpthlp_ta', 'rtpthlp_tp1', 'rtpthlp_tp2', 'rtpthlp_dp1', 'rtpthlp_dp2', 'rtpthlp_cl', 'rtpthlp_sf', 'rtpthlp_forcing', 'rtpthlp_mc', 'wpthlp_enter_mfl', 'wpthlp_exit_mfl', 'wprtp_enter_mfl', 'wprtp_exit_mfl', 'wpthlp_mfl_min', -'wpthlp_mfl_max', 'wprtp_mfl_min', 'wprtp_mfl_max', 'Richardson_num', 'shear_sqd' +'wpthlp_mfl_max', 'wprtp_mfl_min', 'wprtp_mfl_max', 'shear_sqd' diff --git a/cime_config/usermods_dirs/eworg_opt_clubb/user_nl_cam b/cime_config/usermods_dirs/eworg_opt_clubb/user_nl_cam new file mode 100644 index 0000000000..96bd29255e --- /dev/null +++ b/cime_config/usermods_dirs/eworg_opt_clubb/user_nl_cam @@ -0,0 +1,3 @@ +clubb_l_diag_lscale_from_tau = .true. +clubb_penta_solve_method = 2 +clubb_tridiag_solve_method = 2 diff --git a/cime_config/usermods_dirs/scam_mandatory/shell_commands b/cime_config/usermods_dirs/scam_mandatory/shell_commands index 5230507d8a..4fa8390aa5 100755 --- a/cime_config/usermods_dirs/scam_mandatory/shell_commands +++ b/cime_config/usermods_dirs/scam_mandatory/shell_commands @@ -10,6 +10,6 @@ # Note that clm cannot use initial conditions with SCAM -so will only use specified phenology # Only change if CLM_FORCE_COLDSTART exists. -if [ `./xmlquery --value CLM_FORCE_COLDSTART |& grep -c 'ERROR'` -eq 0 ]; then +if [ `./xmlquery --value CLM_FORCE_COLDSTART 2>&1 | grep -c 'ERROR'` -eq 0 ]; then ./xmlchange CLM_FORCE_COLDSTART='on' fi diff --git a/components/cdeps b/components/cdeps new file mode 160000 index 0000000000..46c10740ce --- /dev/null +++ b/components/cdeps @@ -0,0 +1 @@ +Subproject commit 46c10740ce83a154edfc876093f72e7f041c3659 diff --git a/components/cice b/components/cice new file mode 160000 index 0000000000..b56154b318 --- /dev/null +++ b/components/cice @@ -0,0 +1 @@ +Subproject commit b56154b318b41312faec8a8ebee86c866b47c9f2 diff --git a/components/cism b/components/cism new file mode 160000 index 0000000000..c84cc9f5b3 --- /dev/null +++ b/components/cism @@ -0,0 +1 @@ +Subproject commit c84cc9f5b3103766a35d0a7ddd5e9dbd7deae762 diff --git a/components/clm b/components/clm new file mode 160000 index 0000000000..e04b7e2ee9 --- /dev/null +++ b/components/clm @@ -0,0 +1 @@ +Subproject commit e04b7e2ee974aaef93117776a96fd7ce1e774b4d diff --git a/components/cmeps b/components/cmeps new file mode 160000 index 0000000000..1b8920c3bf --- /dev/null +++ b/components/cmeps @@ -0,0 +1 @@ +Subproject commit 1b8920c3bf6c64056d6c1b1b88393617de2fefa3 diff --git a/components/mizuRoute b/components/mizuRoute new file mode 160000 index 0000000000..2ff305a029 --- /dev/null +++ b/components/mizuRoute @@ -0,0 +1 @@ +Subproject commit 2ff305a0292cb06789de6cfea7ad3cc0d6173493 diff --git a/components/mosart b/components/mosart new file mode 160000 index 0000000000..e2ffe00004 --- /dev/null +++ b/components/mosart @@ -0,0 +1 @@ +Subproject commit e2ffe00004cc416cfc8bcfae2a949474075c1d1f diff --git a/components/rtm b/components/rtm new file mode 160000 index 0000000000..b3dfcfbba5 --- /dev/null +++ b/components/rtm @@ -0,0 +1 @@ +Subproject commit b3dfcfbba58c151ac5a6ab513b3515ef3deff798 diff --git a/doc/ChangeLog b/doc/ChangeLog index b1cbe2aea4..251d0d1a9c 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -10,7 +10,7 @@ Purpose of changes (include the issue number and title text for each relevant Gi Add files created by v8 MPAS init_atmosphere model for frontogenesis fields #995 - Runs with MPAS-A dycore and CAM7 physics fail - missing variables in inic files: https://github.com/ESCOMP/CAM/issues/995 -#1094 - Wrap MPAS-A longitudes to [0,2pi) range: https://github.com/ESCOMP/CAM/issues/1094 +#1094 - Wrap MPAS-A longitudes to [0,2pi) range: https://github.com/ESCOMP/CAM/issues/1094 Describe any changes made to build system: N/A @@ -23,6 +23,7 @@ Describe any substantial timing or memory changes: N/A Code reviewed by: adamrher, jtruesdal, cacraigucar, mgduda List all files eliminated: + - mpasa120_L32_topo_coords_c201022.nc Eliminated, replaced by newer versions: @@ -111,6 +112,3650 @@ URL for AMWG diagnostics output used to validate new climate: =============================================================== =============================================================== +Tag name: cam6_4_019 +Originator(s): katec, cacraig, vlarson, bstephens82, huebleruwm, zarzycki, JulioTBacmeister, jedwards4b +Date: 12 August 2024 +One-line Summary: New CLUBB external, new GPU/nvhpc test suite, new CDEPS external +Github PR URL: https://github.com/ESCOMP/CAM/pull/1086 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - New CLUBB external with fixes to support GPU testing #1036 + - part of cam6_4_019: Add GPU regression test suite #1048 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + - Add default vaules for a few new CLUBB namelist parameters: clubb_bv_efold, clubb_wpxp_Ri_exp, and clubb_z_displace + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraigucar, sjsprecious, adamrher, bstephens82 + +List all files eliminated: + cime/config/testmods_dirs/cam/outfrq9s_mg3_nondefault/shell_comands + cime/config/testmods_dirs/cam/outfrq9s_mg3_nondefault/user_nl_cam + cime/config/testmods_dirs/cam/outfrq9s_mg3_nondefault/user_nl_clm + - Removed as part of GPU test updates + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + .gitmodules + - Point to new CLUBB external (clubb_4ncar_20240605_73d60f6_gpufixes_posinf) + and new CDEPS external (cdeps1.0.45) + + cime/config/testdefs/testlist_cam.xml + - Add nvhpc gpu test on Derecho, remove Casper tests + + cime/config/testdefs/testmods_dirs/cam/outfrq9s_mg2_default/shell_commands + cime/config/testdefs/testmods_dirs/cam/outfrq9s_mg3_default/shell_commands + - Change NTASKS for Derecho gpus + + cime/config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/ + - Directory renamed to cime/config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760 + - Files updated to reflect the change + + doc/ChangeLog_template + - Added space for new derecho/nvhpc required tests + + src/physics/cam/clubb_intr.F90 + src/physics/cam/subcol_SILHS.F90 + - Updates to support the new external + + test/system/archive_baseline.sh + test/system/test_driver.sh + - Updates to require CAM_FC compiler specification on Derecho (either intel or nvhpc) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +- pre-existing failures -- need fix in CLM external + +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure -- need fix in CICE external + +ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: +ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: +ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: +ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: +ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: +ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: +ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: DIFF) details: +ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: +ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: +SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: +SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) details: +SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: +SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) details: +SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: +SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: +SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: +SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: +SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: +SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: +SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: +SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: +SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: +- Expected differences due to the new CLUBB external (See PR for discussion) + +derecho/nvphc/aux_cam: + +ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default (Overall: DIFF) + FAIL ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default BASELINE /glade/campaign/cesm/community/amwg/cam_baselines/cam6_4_018_intel: ERROR BFAIL baseline directory '/glade/campaign/cesm/community/amwg/cam_baselines/cam6_4_018_intel/ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default' does not exist +- Expected baseline compare fail due to no baselines stored for GPU tests that didn't exist previously + +izumi/nag/aux_cam: +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +- pre-existing failure - issue #670 + +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: +ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: +ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: +ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: +SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: +SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: +- Expected differences due to the new CLUBB external (See PR for discussion) + +izumi/gnu/aux_cam: +ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: +ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) details: +- Expected differences due to the new CLUBB external (See PR for discussion) + +CAM tag used for the baseline comparison tests if different than previous +tag: cam6_4_018 + +Summarize any changes to answers: + All compsets that use CLUBB (cam6+) will have slight answer changes. Discussion in PR. + Nvhpc gpu tests have no stored baseline for comparison. + +=============================================================== + +Tag name: cam6_4_018 +Originator(s): peverwhee, jedwards4b +Date: 30 July 2024 +One-line Summary: Update git-fleximod to 8.4 and add fleximod_test workflow +Github PR URL: https://github.com/ESCOMP/CAM/pull/1107 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Issue #1113 - Add git-fleximod github CI workflow + +Describe any changes made to build system: update git-fleximod + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraigucar + +List all files eliminated: none + +List all files added and what they do: + +A .github/workflows/fleximod_test.yaml + - add git-fleximod test github workflow + +List all existing files that have been modified, and describe the changes: + +M .gitmodules + - fix fxDONOTUSEurl for cice + +M .lib/git-fleximod/git_fleximod/cli.py +M .lib/git-fleximod/git_fleximod/git_fleximod.py +M .lib/git-fleximod/git_fleximod/submodule.py +M .lib/git-fleximod/pyproject.toml +M .lib/git-fleximod/tbump.toml + - update git-fleximod to v8.4 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +- pre-existing failures -- need fix in CLM external + +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure -- need fix in CICE external + +izumi/nag/aux_cam: + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +- pre-existing failure - issue #670 + +izumi/gnu/aux_cam: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB, as expected + +=============================================================== + +Tag name: cam6_4_017 +Originator(s): eaton +Date: 30 July 2024 +One-line Summary: miscellaneous fixes +Github PR URL: https://github.com/ESCOMP/CAM/pull/1112 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Fixes for: +Issue #1087 - Prevent users from turning on OpenMP when using the SE dycore +Issue #1103 - Bug with physprops files for mam4_mode3 for RRTMGP + +Describe any changes made to build system: +. add check in CAM's configure to fail if SMP is specified with the SE dycore. + +Describe any changes made to the namelist: +. fix attributes in namelist defaults to get the correct physprops file for + mam4_mode3 with RRTMGP + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraig + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +bld/configure +. If smp is on and the dycore is SE, issue message and exit. + +bld/namelist_files/namelist_defaults_cam.xml +. add missing phys="cam6" attribute so cam7 runs get the correct version of + mam4_mode3_file for rrtmgp + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: +. diff due to updating the mam4_mode3 physprop file + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +- pre-existing failures -- need fix in CLM external + +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure -- need fix in CICE external + +izumi/nag/aux_cam: + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +- pre-existing failure - issue #670 + +izumi/gnu/aux_cam: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except cam7/rrtmgp configurations +have different answers due to changing the mam4_mode3 physprops file. + +=============================================================== +=============================================================== + +Tag name: cam6_4_016 +Originator(s): brianpm, eaton +Date: 25 July 2024 +One-line Summary: Modify RRTMGP interface for MT configurations. +Github PR URL: https://github.com/ESCOMP/CAM/pull/1100 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Issue #1063 - Possible modification to RRTMG-P for ~80km top model +. Modify the RRTMGP interface for the special case when the minimum valid + pressure for RRTMGP (1 Pa) falls in the top model layer (as it does in + CAM's 93 level MT configuration). The modification is to use the "extra + layer" code path, and add a very thin extra layer just below 1 Pa. The + algorithm to calculate the midpoint pressure in the "extra layer" has + changed from the original (which assumed a model top at 0 Pa). Hence the + change affects answers for the low top model configurations (cam7-LT and cam6) + as well as the cam7-MT configuration. + + Note that this modification is still being tested for scientific validity + in the cam7-MT configuration. + +Issue #1097 - HEMCO reference in .gitmodules is a branch not a tag. +. Modify .gitmodules to resolve #1097 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraig + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +.gitmodules +- hemco-cesm1_2_1_hemco3_6_3_cesm_rme => hemco-cesm1_2_1_hemco3_6_3_cesm_rme01 + +src/physics/rrtmgp/radiation.F90 +src/physics/rrtmgp/rrtmgp_inputs.F90 +. Identify special case of 1 Pa pressure level being contained in the top + model layer. Treat that case as though an "extra layer" is needed, and + add a very thin extra layer just below 1 Pa. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: +- diffs due to change in RRTMGP interface + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +- pre-existing failures -- need fix in CLM external + +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure -- need fix in CICE external + +izumi/nag/aux_cam: + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +- pre-existing failure - issue #670 + +izumi/gnu/aux_cam: + +ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) +SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp (Overall: DIFF) +- diffs due to change in RRTMGP interface + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except answer changes expected for +configurations using cam7MT, cam7LT, and cam6 with RRTMGP + +=============================================================== +=============================================================== + +Tag name: cam6_4_015 +Originator(s): jedwards, eaton +Date: 23 July 2024 +One-line Summary: misc fixes: buildcpp, check_energy +Github PR URL: https://github.com/ESCOMP/CAM/pull/1072 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +. Issue #1045 - buildcpp does not report errors reported by cam configure + - modify buildcpp so that error messages from CAM's configure appear in + the log output + +. Issue #1015 - SILHS subcolumns output as all zeros. + - testing for this issue revealed a bug when subcolumns were used with + the SE dycore. A fix is added to check_energy.F90. This doesn't fix + the problem with zeros in the subcolumn output, but that is the same + problem previously reported for COSP in issue #944. The problem only + appears when SE grid output is interpolated. A workaround is to output + the subcolumns on the native SE grid. + +. Issue #1044 - Remove solar_htng_spctrl_scl from aquaplanet use case + - also cleaned up the aquaplanet_rce_cam6.xml file which had duplicated + settings of several variables. The second setting is not used because + the first setting takes precedence. Note that the setting of + solar_htng_spctrl_scl to false in aquaplanet_rce_cam6.xml is needed + because it is overriding the default of true for cam6 with RRTMG. + +. resolves #1045 (and replaces PR #1046) +. resolves #1015 +. resolves #1044 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraig + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +bld/namelist_files/use_cases/aquaplanet_cam5.xml +bld/namelist_files/use_cases/aquaplanet_cam6.xml +. remove solar_htng_spctrl_scl + +bld/namelist_files/use_cases/aquaplanet_rce_cam6.xml +. remove duplicated (and hence unused) settings for solar_irrad_data_file, + prescribed_ozone_file, and solar_htng_spctrl_scl + +cime_config/buildcpp +. run configure command from run_cmd() rather than run_cmd_no_fail() and + pass error output to logger.warning() + +src/physics/cam/check_energy.F90 +. fix out of bounds array references when subcolumns are used in the SE + specific hydrostatic energy scaling. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) +- pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) +- pre-existing failures -- need fix in CLM external + +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) +- pre-existing failure -- need fix in CICE external + +izumi/nag/aux_cam: + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +- pre-existing failure - issue #670 + +izumi/gnu/aux_cam: + +ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) +- solution diffs because solar_htng_spctrl_scl is now getting the correct + value of .false. (what RRTMGP requires). The use case file was + previously incorrectly setting this value to .true. (what RRTMG requires). + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam6_4_014 +Originator(s): fvitt +Date: 22 Jul 2024 +One-line Summary: Clean up WACCMX use of ESMF gridded component +Github PR URL: https://github.com/ESCOMP/CAM/pull/1069 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Remove the ESMF gridded component layer in WACCMX #1055 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: gold2718 cacraigucar + +List all files eliminated: +D src/ionosphere/waccmx/edyn_grid_comp.F90 + - remove gridded component layer which was needed for MCT component coupling + +List all files added and what they do: +A src/ionosphere/waccmx/edyn_phys_grid.F90 + - manaages the physics grid mesh for ESMF regridding + +List all existing files that have been modified, and describe the changes: +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cam.xml + - default rxn_rate_sums for waccmx + +M bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml +M bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml + - changes for zm history fields + +M cime_config/testdefs/testlist_cam.xml + - multi-instance test + +M src/ionosphere/waccmx/edyn_init.F90 +M src/ionosphere/waccmx/ionosphere_interface.F90 + - invoke dpie_coupling directly + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + NLFAIL ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s + - new namelist includes default rxn_rate_sums for waccmx + + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + PEND SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + FAIL SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s + - pre-existing failure -- will go away when CICE external is updated post git-fleximod + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + + NLFAIL SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s + - new namelist includes default rxn_rate_sums for waccmx + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_4_013 +Originator(s): fvitt, tilmes +Date: 21 Jul 2024 +One-line Summary: Aerosol wet removal bug fixes +Github PR URL: https://github.com/ESCOMP/CAM/pull/1085 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Fix aerosol convective wet removal bugs #1024 + . Move adjustment of dcondt to after tendencies are moved to largest mode + when convproc_do_evaprain_atonce is TRUE + . Fix indexing issues in application of resuspension tendencies to + cloud-borne aerosols + . Do convective wet removal before stratoform rain out + . Move calculation of aerosol wet radius from wetdep subroutine to physpkg + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M src/chemistry/bulk_aero/aero_model.F90 + - need wetdep_lq public + +M src/chemistry/modal_aero/aero_model.F90 + - need wetdep_lq public + - add convective wet removal diagnostics + - move calc of wet radius from wetdep subroutine to physpkg + - do convective wet removal before stratoform rain out + - fix indexing issues in application of resuspension tendencies to + cloud-borne aerosols + +M src/chemistry/modal_aero/modal_aero_convproc.F90 + - add convective wet removal diagnostics + - move adjustment of dcondt to after tendencies are moved to largest mode + when convproc_do_evaprain_atonce is TRUE + +M src/physics/cam/physpkg.F90 +M src/physics/cam_dev/physpkg.F90 + - move calc of wet radius from wetdep subroutine to physpkg + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + PEND SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + FAIL SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s + - pre-existing failure -- will go away when CICE external is updated post git-fleximod + + DIFF ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp + DIFF ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase + DIFF ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase + DIFF ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s + DIFF ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s + DIFF ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp + DIFF ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s + DIFF ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d + DIFF ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 + DIFF ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes + DIFF ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 + DIFF ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 + DIFF ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 + DIFF SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep + DIFF SMS_D_Ld2.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase + DIFF SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday + DIFF SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 + DIFF SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie + DIFF SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase + DIFF SMS_D_Ln9.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d + DIFF SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d + DIFF SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d + DIFF SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h + DIFF SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m + DIFF SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging + DIFF SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s + DIFF SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs + DIFF SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp + - baseline differences due to changes in aersol wet removal + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + + DIFF ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt + DIFF ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp + DIFF ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol + DIFF ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am + DIFF ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist + DIFF ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s + DIFF ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s + DIFF ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac + DIFF ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac + DIFF ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 + DIFF ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf + DIFF PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 + DIFF PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 + DIFF PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 + DIFF PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 + DIFF PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 + DIFF PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 + DIFF SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam + DIFF SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase + DIFF SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s + DIFF TMC_D.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac + DIFF TMC_D.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 + - baseline differences due to changes in aersol wet removal + +izumi/gnu/aux_cam: + DIFF ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon + DIFF ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s + DIFF ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp + DIFF ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s + DIFF PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 + DIFF PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 + DIFF PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 + DIFF SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 + DIFF SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac + - baseline differences due to changes in aersol wet removal + +Summarize any changes to answers: larger than roundoff but same climate + +URL for AMWG diagnostics output used to validate new climate: + https://acomstaff.acom.ucar.edu/tilmes/amwg/cam7/f.cam6_3_160.FMTHIST_ne30.moving_mtn.output.conv6_1996_2005_vs_f.cam6_3_160.FMTHIST_ne30.moving_mtn.output.001_1996_2005/website/index.html + + +=============================================================== +=============================================================== + +Tag name: cam6_4_012 +Originator(s): fvitt, tilmes, lkemmons +Date: 19 Jul 2024 +One-line Summary: Add climate-chemistry compset +Github PR URL: https://github.com/ESCOMP/CAM/pull/1074 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Add climate-chemistry compset (FCts4MTHIST) which uses a simplified chemistry mechanism (trop_strat_mam5_ts4) + (Implement Climate-Chemistry compset #1064). + + Update user defined reaction rates for tagged CO species + (Updates to mo_usrrxt chemistry module #1065). + + Fix issue in cam7 physics where the water paths are not defined before they + are used in cloud optics on the 1st time step. + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar + +List all files eliminated: N/A + +List all files added and what they do: +A bld/namelist_files/use_cases/hist_trop_strat_ts4_cam7.xml + - out-of-the box namelist settings for FCts4MTHIST compset + +A src/chemistry/pp_trop_strat_mam5_ts4/chem_mech.doc +A src/chemistry/pp_trop_strat_mam5_ts4/chem_mech.in +A src/chemistry/pp_trop_strat_mam5_ts4/chem_mods.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/m_rxt_id.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/m_spc_id.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_adjrxt.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_exp_sol.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_imp_sol.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_indprd.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_lin_matrix.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_lu_factor.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_lu_solve.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_nln_matrix.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_phtadj.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_prod_loss.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_rxt_rates_conv.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_setrxt.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_sim_dat.F90 + - new climate-chemistry mechanism + +List all existing files that have been modified, and describe the changes: +M bld/build-namelist + - set emissions appropriately for the new climate-chemistry compset + +M bld/config_files/definition.xml +M bld/configure + - new climate-chemistry trop_strat_mam5_ts4 chemisty package + +M bld/namelist_files/namelist_defaults_cam.xml + - rxn_rate_sums for new climate-chemistry trop_strat_mam5_ts4 + - default ne3 IC file for trop_strat_mam5_ts4 + +M cime_config/config_component.xml +M cime_config/config_compsets.xml + - new climate-chemistry compset FCts4MTHIST + +M cime_config/testdefs/testlist_cam.xml + - add tests for FCts4MTHIST + +M src/chemistry/mozart/mo_usrrxt.F90 + - changes for tagged CO reactions + +M src/physics/cam/cloud_diagnostics.F90 +M src/physics/cam/physpkg.F90 +M src/physics/cam7/physpkg.F90 + - initialize water paths to zero before they are used by cloud optics in cam7 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + PEND SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + FAIL SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s + - pre-existing failure -- will go away when CICE external is updated post git-fleximod + + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq9s + - new test for the FCts4MTHIST compset + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: All Pass + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_4_011 +Originator(s): jedwards, eaton, cacraig +Date: July 19, 2024 +One-line Summary: Update submodules, git-fleximod; fix fv3 build; remove mct reference +Github PR URL: https://github.com/ESCOMP/CAM/pull/1089 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +This PR replaces PR #1067 and #1075 by merging them with other updates. + +. update submodules to be consistent with cesm3_0_alpha02a + +. merge in PR #1067 - fix the path to fms for fv3 build, remove mct reference: https://github.com/ESCOMP/CAM/issues/1068 + +. merge in PR #1075 - Git fleximod update0.8.2: https://github.com/ESCOMP/CAM/issues/1076 + +. Fix CLM regression errors due to their upgrade and older version no longer working with CAM7 runs: https://github.com/ESCOMP/CAM/issues/1091 + +. resolves #1076 +. resolves #1068 +. resolves #1091 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraig + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +.gitmodules +. remove submodule "mct" +. cismwrap_2_2_001 -> cismwrap_2_2_002 +. rtm1_0_79 -> rtm1_0_80 +. mosart1_0_49 -> mosart1.1.02 +. cesm-coupling.n02_v2.1.2 -> cesm-coupling.n02_v2.1.3 +. ccs_config_cesm0.0.106 -> ccs_config_cesm1.0.0 +. cime6.0.246 -> cime6.1.0 +. cmeps0.14.67 -> cmeps1.0.2 +. cdeps1.0.34 -> cdeps1.0.43 +. share1.0.19 -> share1.1.2 +. ctsm5.2.007 -> ctsm5.2.009 + +cime_config/buildcpp +. remove mct conditional + +cime_config/buildlib +. fix sharedpath and fmsbuilddir + +cime_config/config_compsets.xml +. Change from CLM51 to CLM60 for all CAM7 compsets + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s RUN + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s GENERATE exception + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD + - pre-existing failures - need fix in CLM external + + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s RUN time=65 + - Bug in med.F90 - Will go away when CICE external is updated post git-fleximod + + ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERI_D_Ln18.f45_f45_mg37.QPC41850.derecho_intel.cam-co2rmp_usecase (Overall: DIFF) details: + ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: DIFF) details: + ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep (Overall: DIFF) details: + SMS_D_Ld2.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - Answer changes due to external updates - FIELDLIST differ only + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + PEND DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure - issue #670 + + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + ERC_D_Ln9.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) details: + SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + - Answer changes due to external updates - FIELDLIST differ only + +izumi/gnu/aux_cam: + ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) details: + ERI_D_Ln18.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: DIFF) details: + ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + SMS_D_Ln3.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) details: + SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - Answer changes due to external updates - FIELDLIST differ only + +Summarize any changes to answers: FIELDLIST differences only + +=============================================================== +=============================================================== + +Tag name: cam6_4_010 +Originator(s): juliob, cacraig +Date: July 18, 2024 +One-line Summary: Initial Gravity Wave moving mountain +Github PR URL: https://github.com/ESCOMP/CAM/pull/1057 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - New gravity wave source - "moving mountains": https://github.com/ESCOMP/CAM/issues/942 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + - Introduce: + use_gw_movmtn_pbl - If true, then turns on GW moving mountain from PBL moving mountain source + alpha_gw_movmtn - Tunable parameter controlling proportion of boundary layer momentum flux escaping + as GW momentum flux + gw_drag_file_mm - Relative pathname of lookup table for deep convective moving mountain GW source + NOTE - This file is expected to be replaced, so it has not been committed to the svn repository and + only resides on derecho. + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraig, nusbaume + +List all files eliminated: + +List all files added and what they do: +A src/physics/cam/gw_movmtn.F90 + - Moving mountain module + +List all existing files that have been modified, and describe the changes: +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cam.xml +M bld/namelist_files/namelist_definition.xml + - Mods for new namelist variables described above + +M src/physics/cam/clubb_intr.F90 +M src/physics/cam/gw_drag.F90 +M src/physics/cam/phys_control.F90 + - Mods to support moving mountains + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s RUN + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s GENERATE exception + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD + - pre-existing failures - need fix in CLM external + + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s RUN time=65 + - Bug in med.F90 - Will go away when CICE external is updated post git-fleximod + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + - Baseline differences due to using moving mountains for CAM7 runs (Also had NLCOMP failures for these exact same tests) + + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + PEND DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: all pass + +Summarize any changes to answers, i.e., +- what code configurations: all CAM7 +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): Julio ran FMTHIST for 4 years and approved the results + + +=============================================================== +=============================================================== + +Tag name: cam6_4_009 +Originator(s): bdobbins, fvitt, cacraig +Date: July 11th, 2024 +One-line Summary: replaced outdated log-gamma function with intrinsic +Github PR URL: https://github.com/ESCOMP/CAM/pull/1081 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Cleanup - replacing log-gamma function with F2008 intrinsic in WACCMX code #1080 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: fvitt + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M src/ionosphere/waccmx/wei05sc.F90 + - Replaces calls to a log-gamma function w/ math intrinsic + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD + - pre-existing failures - need fix in CLM external + + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s RUN time=41 + - Bug in med.F90 - Will go away when CICE external is updated post git-fleximod + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + PEND DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: None + +=============================================================== +=============================================================== + +Tag name: cam6_4_008 +Originator(s): pel, cacraig +Date: July 10, 2024 +One-line Summary: HB mods + dycore mods +Github PR URL: https://github.com/ESCOMP/CAM/pull/1071 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Possible modification to HB in CAM7: https://github.com/ESCOMP/CAM/issues/1062 + - HB diffusion in CAM6/7 performs mixing for stable conditions (Ri>0) as well as background mixing in addition to unstable + mixing (Ri<0) + - Modify HB in CAM6/7 to only mix for unstable conditions + - add div4 sponge (in SE dycore) in MT configuration for stability + - friction frictional heating in del4 sponge + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraig + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M src/atmos_phys + - Directory which was updated in cam6_4_007, but not committed + +M src/dynamics/se/dycore/global_norms_mod.F90 +M src/dynamics/se/dycore/prim_advance_mod.F90 +M src/physics/cam/hb_diff.F90 +M src/physics/cam/pbl_utils.F90 + - changes as described above + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD RERUN + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD RERUN + - pre-existing failures - need fix in CLM external + + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s RUN time=44 + - Bug in med.F90 - Will go away when CICE external is updated post git-fleximod + + ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: DIFF) details: + ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - All tests which use CLUBB will have answer changes + + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + PEND DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure - issue #670 + + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + - All tests which use CLUBB will have answer changes + + +izumi/gnu/aux_cam: + ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - All tests which use CLUBB will have answer changes + + +=============================================================== +=============================================================== + +Tag name: cam6_4_007 +Originator(s): Michael Waxmonsky +Date: 7/8/2024 +One-line Summary: cam6_4_007: CCPP-ized TJ2016 +Github PR URL: https://github.com/ESCOMP/CAM/pull/1070 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +- Exchanges TJ2016 source from cam/physics/simple to atmospheric_physics +submodule (https://github.com/ESCOMP/atmospheric_physics/pull/92) + +Describe any changes made to build system: +- Adds src/atmos_phys/tj2016 to list of folders to search for compiling in +/bld/atm/obj/Filepath used during ./preview_namelists + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar, nusbaume + +List all files eliminated: + +$ git diff --name-status cam_development..tj2016 | grep ^D +D src/physics/simple/tj2016.F90 + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +$ git diff --name-status cam_development..tj2016 | grep ^M + +M .gitmodules +- Updating atmospheric_physics to tag atmos_phys0_03_000 + +M bld/configure +- See comment to change in build system + +M src/physics/simple/tj2016_cam.F90 +- Updated API into CCPP-ized TJ2016 precip and sfc_plb_hs run functions + (See https://github.com/ESCOMP/atmospheric_physics/pull/92 for API change desciription). + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s +(Overall: FAIL) details: + FAIL SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD time=3 +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s RUN RERUN +- Pre-existing failures + +izumi/nag/aux_cam: +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=12 + PEND DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da +- Pre-existing failure + +izumi/gnu/aux_cam: N/A + +CAM tag used for the baseline comparison tests if different than previous +tag: +- cesm2_3_alpha17g for manually testing FTJ16 compset + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new climate): N/A + +=============================================================== + +Tag name: cam6_4_006 +Originator(s): pel, eaton +Date: 3 July 2024 +One-line Summary: fix clubb interface bug (dry/moist mixing ratio conversion) +Github PR URL: https://github.com/ESCOMP/CAM/pull/1054 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - fix issue described in https://github.com/ESCOMP/CAM/issues/1053 + . refactor set_wet_to_dry and set_dry_to_wet to require specifying which + constituent type the mixing ratio conversion is applied to + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +.gitmodules +- update fv3 from fv3int_053124 to fv3int_061924 + +src/physics/cam/clubb_intr.F90 +- add convert_cnst_type='wet' to arg list for set_wet_to_dry + +src/physics/cam/physics_types.F90 +- refactor set_wet_to_dry and set_dry_to_wet to require specifying which + constituent mixing ratios are being converted. + +src/dynamics/fv3/dp_coupling.F90 +src/dynamics/fv/dp_coupling.F90 +- add convert_cnst_type='dry' to arg list for set_wet_to_dry + +src/physics/cam/gw_drag.F90 +src/physics/cam/physpkg.F90 +src/physics/carma/cam/carma_intr.F90 +src/physics/simple/physpkg.F90 +- add convert_cnst_type='dry' to arg list for set_dry_to_wet + +src/physics/cam/vertical_diffusion.F90 +- add convert_cnst_type='dry' to arg list for set_dry_to_wet + and set_wet_to_dry + +src/physics/carma/models/cirrus/carma_cloudfraction.F90 +src/physics/carma/models/cirrus_dust/carma_cloudfraction.F90 +- remove unused association of set_dry_to_wet and set_wet_to_dry + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) +- pre-existing failures + +ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) +ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) +ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) +ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) +ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) +ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) +ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: DIFF) +ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) +ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) +SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) +SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) +SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) +SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) +SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) +SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) +SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) +SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) +SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) +SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) +SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) +SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) +SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) +- expected baseline differences for cam6/cam7 physics + +izumi/nag/aux_cam: + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) +- pre-existing failure + +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) +ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) +ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) +ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) +SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) +SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) +- expected baseline differences for cam6 physics + +izumi/gnu/aux_cam: + +ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s (Overall: DIFF) +ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) +- expected baseline differences for cam6 physics + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except all tests using CLUBB (i.e., + cam6 and cam7 physics) will have baseline comparison failures. + +=============================================================== +=============================================================== + +Tag name: cam6_4_005 +Originator(s): eaton +Date: 1 July 2024 +One-line Summary: Limit vertical domain used by COSP. +Github PR URL: https://github.com/ESCOMP/CAM/pull/1010 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +The COSP simulator was not working with "FMT" compsets. This compset has a +model top of about 1 Pa which is above where the cloud parameterizations +operate. The COSP interface routine was modified so that COSP operates on +the same vertical domain as the cloud parameterizations which is set by +the namelist variable trop_cloud_top_press (1 mb by default). Changing to +a dynamically determined top required moving the call to COSP's +initialization. In addition a lot of code cleanup was done, and a bug fix +was made for the layer interface values of height and pressure passed from +CAM to COSP. + +. resolves #967- COSP prevents running "FMT" compsets. + +Removed old tools for topo file generation. + +. resolves #1005 - Remove old topo generation software from CAM + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not measured, but COSP +should be less expensive in models with tops above 1 mb. + +Code reviewed by: cacraig, nusbaume + +List all files eliminated: +tools/definehires/* +tools/definesurf/* +tools/topo_tool/* +. these tools for topo file generation have been replaced by + https://github.com/NCAR/Topo + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +src/control/cam_history_support.F90 +. fix log output format + +src/physics/cam/cospsimulator_intr.F90 +. set top of data operated on by COSP using trop_cloud_top_lev +. cospsimulator_intr_register + - move the setcosp2values call here. That routine contains the call to + COSP's initialization. +. cospsimulator_intr_readnl + - move the call to setcosp2values to cospsimulator_intr_register. +. remove outdated and/or unhelpful comments +. remove unused variables +. remove added history fields that had no corresponding outfld calls +. remove array section notation from places where the whole array is used + +src/physics/cam/ref_pres.F90 +. add calls to create vertical coordinate variables for the domain bounded + by trop_cloud_lev_top. Some COSP history fields need this coordinate. + +src/utils/hycoef.F90 +. add comment and fix a comment + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: All PASS except: +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) +SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) +- pre-existing failures + +izumi/nag/aux_cam: All PASS except: +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: PEND) +- pre-existing failure + +izumi/gnu/aux_cam: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB. Note that although the regression + tests with COSP diagnostics passed, there are some COSP diagnostic fields that + have answer changes due to a bug fix in the data sent to COSP. + +=============================================================== +=============================================================== + +Tag name: cam6_4_004 +Originator(s): fvitt +Date: 29 Jun 2024 +One-line Summary: Misc corrections for WACCM-X +Github PR URL: https://github.com/ESCOMP/CAM/pull/1023 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Implement corrections to: + - geometric height calculations (issue #987) + - thermosphere heating diagnostics (issue #1013) + - DTVKE vertical diffustion diagnostic + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar, nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M src/ionosphere/waccmx/ionosphere_interface.F90 + - Hanli's formulation for geometric height + +M src/physics/cam/vertical_diffusion.F90 + - correction to DTVKE diagnostic + +M src/physics/waccmx/ion_electron_temp.F90 + - corrections to thermosphere heating diagnostics (issue #1013) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s + DIFF SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h + FAIL SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s + PEND SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures + + DIFF ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s + DIFF ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie + DIFF SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s + - expected baseline failures in waccmx due to corrections in diagnostices + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure + + DIFF SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s + - expected baseline failure in waccmx due to corrections in diagnostices + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_4_003 +Originator(s): adamrher, jet +Date: Thu Jun 28, 2024 +One-line Summary: Corrected L93 default IC files +Github PR URL: https://github.com/ESCOMP/CAM/pull/1040 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + The L93 hybrid coefficients had a discontinuous kink, or offset, creating an anomalously thin layer + in the 300 hPa - 100 hPa altitude range. This region overlaps with the L58 grid, but for some reason + the L58 grid didn't get contaminated like it was in L93. We aren't sure how this happened. + More here: https://github.com/ESCOMP/CAM/issues/1034 + + fixes #1034 - Problematic hybrid coefficients in L99 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: Files with problematic hybrid coeff were + regenerated. + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraigucar, jet + +List all files eliminated: + Boundary data defaults eliminated from namelist_defaults_cam.xml (files still exist but will no longer be used) + atm/cam/inic/se/f.cam6_3_112.FCMTHIST_v0c.ne30.non-ogw-ubcT-effgw0.7.001.cam.i.1998-01-01-00000_c230810.nc + atm/cam/inic/se/cam7_FMT_ne30pg3_mg17_L93_c221118.nc + atm/cam/inic/se/cam6_QPC6_topo_ne3pg3_mg37_L93_01-01-31_c221214.nc + atm/cam/inic/se/cam6_QPC6_aqua_ne3pg3_mg37_L93_01-01-31_c221214.nc + +List all files added and what they do: + New files added to data repo and namelist_defaults-cam.xml: + atm/cam/inic/se/f.cam6_3_160.FCMT_ne30.moving_mtn.001.cam.i.1996-01-01-00000_c240618.nc + atm/cam/inic/se/c153_ne30pg3_FMTHIST_x02.cam.i.1990-01-01-00000_c240618.nc + atm/cam/inic/se/cam6_FMTHIST_ne3pg3_mg37_L93_79-02-01_c240517.nc + atm/cam/inic/se/cam6_QPC6_aqua_ne3pg3_mg37_L93_01_02_01_c240518.nc + +List all existing files that have been modified, and describe the changes: + +bld/namelist_files/namelist_defaults_cam.xml +. Replaced problematic 93 level IC defaults with new files. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: BFB except: + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failures + +SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +- expected change due to new IC default + +izumi/nag/aux_cam: BFB except: + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +- pre-existing failure + +izumi/gnu/aux_cam: BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: NA + +Summarize any changes to answers: This changes answers for + configurations using new default 93L IC files. + + +=============================================================== +=============================================================== + +Tag name: cam6_4_002 +Originator(s): adamrher, eaton +Date: Wed Jun 26, 2024 +One-line Summary: activate additional clubb diffusion in cam6 +Github PR URL: https://github.com/ESCOMP/CAM/pull/1056 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Resolves #1041 - cam6 should have additional clubb diffusion activated but it doesn't + +. The fix is to set the namelist defaults for clubb_l_do_expldiff_rtm_thlm + the same way that defaults were set for clubb_expldiff before tag cam6_3_059. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: +. defaults changed for clubb_l_do_expldiff_rtm_thlm + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraigucar, nusbaume + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +bld/namelist_files/namelist_defaults_cam.xml +. change defaults for clubb_l_do_expldiff_rtm_thlm to be true when clubb is + used, except when clubb is used with silhs. False otherwise. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: BFB except: + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failures + +SMS_Ld5.f09_f09_mg17.PC6.derecho_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: +- namelist change for cam6 physics. No answer change for PORT test. + +ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: +ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: +ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: +ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: +ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: +ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: +ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: +SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: +SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) details: +SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: +SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) details: +SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: +SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: +SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: +SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: +SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: +SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: +SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: +SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: +- answer change for cam6 physics + +izumi/nag/aux_cam: BFB except: + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +- pre-existing failure + +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: +ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: +ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: +ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: +SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: +SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: +- answer change for cam6 physics + +izumi/gnu/aux_cam: BFB except: + +ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: +ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) details: +- answer changes in cam6 physics + +SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp (Overall: NLFAIL) details: +- namelist change for cam6 physics. No answer change for this PORT test. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: This changes answers for all + configurations using cam6 physics, except for cam6 with silhs. + +=============================================================== +=============================================================== + +Tag name: cam6_4_001 +Originator(s): eaton +Date: Wed Jun 26, 2024 +One-line Summary: Change name of physics package 'cam_dev' to 'cam7' +Github PR URL: https://github.com/ESCOMP/CAM/pull/1028 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +#813 - Introduce "-phys cam7" and remove "-phys cam_dev". +https://github.com/ESCOMP/CAM/issues/813 + +- The compset tokens CAM%DEV are replaced by CAM70 +- The src/physics/cam_dev/ directory is renamed src/physics/cam7 +- No compset names were changed. + +#1033 - Change DART test to use 128 instead of 108 processors +https://github.com/ESCOMP/CAM/issues/1033 + +- SMS_C80_P108x1_Lh1.f09_f09_mg17.FHIST_DARTC6 + changed to + SMS_C80_P128x1_Lh1.f09_f09_mg17.FHIST_DARTC6 + +Issue #1038 - Replace ne16np4 grid for WACCM HIST test with ne16np4.pg3 +https://github.com/ESCOMP/CAM/issues/1039 + +- SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s + changed to + SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s + +Issue #1039 - Change transient ne30np4 cam tests to ne30np4.pg3 #1039 +https://github.com/ESCOMP/CAM/issues/1039 + +- ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s + changed to + ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s + +. resolves #813 +. resolves #1033 +. resolves #1038 +. resolves #1039 + +Describe any changes made to build system: + +. The physics package name 'cam_dev' is replaced by 'cam7' +. The compset component 'CAM%DEV' is replaced by 'CAM70' +. No compset names have been changed. + +Describe any changes made to the namelist: + +. cam_physpkg will be set to cam7 instead of cam_dev + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraigucar, nusbaume + +List all files eliminated: + +cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam_dev/shell_commands +cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam_dev/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam_dev/user_nl_clm +src/physics/cam_dev/cam_snapshot.F90 +src/physics/cam_dev/convect_diagnostics.F90 +src/physics/cam_dev/micro_pumas_cam.F90 +src/physics/cam_dev/physpkg.F90 +src/physics/cam_dev/stochastic_emulated_cam.F90 +src/physics/cam_dev/stochastic_tau_cam.F90 +. These files moved from the directories with 'cam_dev' in the name to + directories with 'cam7' in the name. + +List all files added and what they do: + +cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam7/shell_commands +cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam7/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam7/user_nl_clm +. moved from cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam_dev +. shell_commands has cam_dev changed to cam7 + +src/physics/cam7/cam_snapshot.F90 +src/physics/cam7/convect_diagnostics.F90 +src/physics/cam7/micro_pumas_cam.F90 +src/physics/cam7/physpkg.F90 +src/physics/cam7/stochastic_emulated_cam.F90 +src/physics/cam7/stochastic_tau_cam.F90 +. moved from src/physics/cam_dev + +List all existing files that have been modified, and describe the changes: + +.gitmodules +. CMEPS submodule updated to cmeps0.14.67 + +bld/build-namelist +. change 'cam_dev' to 'cam7' +. a consistency check making sure clubb_sgs is used with cam7 is moved to + configure since these settings are known there. +. add check to disallow user setting of do_clubb_sgs + +bld/namelist_files/namelist_defaults_cam.xml +. add default value for cam_physics_mesh for ne16pg3 + +bld/config_files/definition.xml +. change valid_values for 'phys' from 'cam_dev' to 'cam7' + +bld/configure +. change 'cam_dev' to 'cam7' +. the physics package is always specified in the component definition. + Remove the default setting and make sure the -phys option is set. +. set the default chemistry package for cam7 physics to ghg_mam4 +. the setting for 'model_top' was moved to be near the 'nlev' settings. +. change filepath name from src/physics/cam_dev to src/physics/cam7 +. add check that model_top is only specified for cam7 physics. + +bld/namelist_files/namelist_defaults_cam.xml +. change 'cam_dev' to 'cam7' + +bld/namelist_files/namelist_definition.xml +. update description of do_clubb_sgs to indicate that it is not user + settable. + +cime_config/SystemTests/mgp.py +. change 'cam_dev' to 'cam7' + +cime_config/config_component.xml +cime_config/config_compsets.xml +. change 'CAM%DEV' to 'CAM70' +. modify compset matching so that %LT and %MT are only matched for CAM70 + physics. +. remove %GHGMAM4 modifier (default chemistry set in configure) +. F2000dev, FCLTHIST, FCMTHIST - change CLM50 to CLM51. CLM no longer supports CLM50 + with CAM70 physics. + +cime_config/config_pes.xml +. change 'CAM%DEV' to 'CAM70' + +cime_config/testdefs/testlist_cam.xml +. change 'CAM%DEV' to 'CAM70' +. change 'cam_dev' to 'cam7' +. increased walltime limits for several tests that hit time limits on + derecho +. remove F2000dev tests from aux_cam and prealpha categories. Also remove + 2000_CAM70%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV which is + the same as the updated F2000dev. The remaining F2000dev tests will be + updated to use F2000climo once that compset is updated to CAM7. +. Update the following tests which are currently failing due to missing CLM + datasets to use CSLAM grids rather than pure SE + ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s + SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s +. Change + SMS_C80_P108x1_Lh1.f09_f09_mg17.FHIST_DARTC6 + to + SMS_C80_P128x1_Lh1.f09_f09_mg17.FHIST_DARTC6 +. remove 1 remaining Vmct test + +src/chemistry/mozart/mo_gas_phase_chemdr.F90 +src/physics/cam/nucleate_ice_cam.F90 +src/physics/cam/phys_control.F90 +src/physics/cam/vertical_diffusion.F90 +. change 'cam_dev' to 'cam7' + +src/physics/cam/zm_conv_intr.F90 +. check whether zmconv_parcel_pbl is set true when the bottom layer thickness is + less than 100 m. Issue a warning to the log file if it's not. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: all PASS except: + +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: NLFAIL) details: +SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: +- cam_physpkg changed from cam_dev to cam7 + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure due to HEMCO not having reproducible results + +ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +- these tests changed to CSLAM grids, so no baseline for comparison + +ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: DIFF) details: +- baseline comparisons fail because case name changed from cam_dev to cam7 + +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +- pre-existing failures - need fix in CLM external + CLMBuildNamelist::setup_logic_initial_conditions() : use_init_interp is NOT synchronized with init_interp_attributes in the namelist_defaults file, this should be corrected there + +SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +- expected diff due to changing CLM50 to CLM51 + +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure - need fix in CICE external + fails in med.F90 + +izumi/nag/aux_cam: All PASS except + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +- pre-existing failure + +izumi/gnu/aux_cam: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB - all diffs are due changing the test + grid, the test case name, or the compset definition (CLM50 -> CLM51). + +=============================================================== +=============================================================== + +Tag name: cam6_3_162 +Originator(s): cacraig, jedwards, nusbaume +Date: June 7, 2024 +One-line Summary: Remove manage externals +Github PR URL: https://github.com/ESCOMP/CAM/pull/1052 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Removes manage_externals/checkout_externals and replaces with git-fleximod (no GitHub issue) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar + +List all files eliminated: +D Externals.cfg +D Externals_CAM.cfg +D manage_externals + - Removed manage_externals functionality + +List all files added and what they do: +A .gitmodules +A .lib/git-fleximod + - Add git-fleximod functionality + +A bin/git-fleximod + - The actual git-fleximod executable + +A ccs_config +A chem_proc +A cime +A components/cdeps +A components/cice +A components/cism +A components/clm +A components/cmeps +A components/mizuRoute +A components/mosart +A components/rtm +A libraries/FMS +A libraries/mct +A libraries/parallelio +A share +A src/atmos_phys +A src/chemistry/geoschem/geoschem_src +A src/dynamics/fv3 +A src/dynamics/mpas/dycore +A src/hemco +A src/physics/ali_arms +A src/physics/carma/base +A src/physics/clubb +A src/physics/cosp2/src +A src/physics/pumas +A src/physics/pumas-frozen +A src/physics/rrtmgp/data +A src/physics/rrtmgp/ext + - Added external directories as required by git-submodule, which git-fleximod is built upon + +List all existing files that have been modified, and describe the changes: + +M .gitignore + - Removed unneeded gitignore lines + +M README.md + - Updated README to reflect new git-fleximod + +M manage_externals/checkout_externals + - Script which tells folks where to find git-fleximod (when they were used to running manage_externals) + +M test/system/TGIT.sh + - modified test to include a check for require .gitmodules file + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +Most tests had the following namelist failures: + ----- +Comparison failed between '/glade/derecho/scratch/cacraig/aux_cam_20240606135848/SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem.GC.aux_cam_20240606135848/CaseDocs/nuopc.runconfig' with '/glade/campaign/cesm/community/amwg/cam_baselines/cam6_3_161/SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem/CaseDocs/nuopc.runconfig' +DRIVER_attributes->PELAYOUT_attributes->ALLCOMP_attributes: +ocn2glc_levels as key not in /glade/derecho/scratch/cacraig/aux_cam_20240606135848/SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem.GC.aux_cam_20240606135848/CaseDocs/nuopc.runconfig + ----- + +derecho/intel/aux_cam: + + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failure due to HEMCO not having reproducible results + + ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + FAIL ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h BASELINE /glade/campaign/cesm/community/amwg/cam_baselines/cam6_3_161: ERROR BFAIL some baseline files were missing + - This test did not run in previous tag due to CTSM tag failure. Is now running, but no baseline to compare against + + ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD failed to initialize + SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD + - These transient grids are no longer supported by CTSM - will update tests in future PR + + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s RUN time=43 + - Bug in med.F90 - Will go away when CICE external is updated post git-fleximod + + SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + FAIL SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m BASELINE +/glade/campaign/cesm/community/amwg/cam_baselines/cam6_3_161: FIELDLIST field lists differ (otherwise bit-for-bit) + - cice history file has attributes that changed with this run + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: + SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_161_gnu: ERROR BFAIL some baseline files were missing + - This test did not run in previous tag due to CTSM tag failure. Is now running, but no baseline to compare against + +=============================================================== +=============================================================== + +Tag name: cam6_3_161 +Originator(s): cacraig +Date: May 16, 2024 +One-line Summary: Update to alpha17 externals +Github PR URL: https://github.com/ESCOMP/CAM/pull/1031 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update externals to match externals which will be used in cesm2_3_beta17: https://github.com/ESCOMP/CAM/issues/985 + - Bring in ccs_config0.0.99: https://github.com/ESCOMP/CAM/issues/1021 + - Unable to compile cam6_3_154 with nvhpc/24.3 on Derecho: https://github.com/ESCOMP/CAM/issues/1025 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - update externals to match cesm2_3_beta17 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +NOTE - most tests have namelist differences due to mediator namelist changes + +derecho/intel/aux_cam: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failure + + ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: FAIL) details: + - Bug during CREATE_NEWCASE in CTSM code - will go away when CTSM external is updated post git-fleximod + + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - Bug in med.F90 - Will go away when CICE external is updated post git-fleximod + + ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD failed to initialize + SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD time=2 + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD time=1 + - Bugs reported to CTSM and will be fixed when CTSM external is updated post git-fleximod + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000dev.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.f19_f19.F2000dev.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - Answer changes due to updated externals + +izumi/nag/aux_cam: all B4B, except: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: all BFB except: + SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: FAIL) details: + - Bug during CREATE_NEWCASE in CTSM code - will go away when CTSM external is updated post git-fleximod + + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - answer changes due to updated externals + + +CAM tag used for the baseline comparison tests if different than previous +tag: cam6_3_159 as cam6_3_160 did not run regression tests + + +=============================================================== +=============================================================== + +Tag name: cam6_3_160 +Originator(s): cacraig, jedwards +Date: April 29, 2024 +One-line Summary: workaround so that sct works on derecho +Github PR URL: https://github.com/ESCOMP/CAM/pull/1019 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Newest ccs_config tag causes the derecho_intel SCT test to fail: https://github.com/ESCOMP/CAM/issues/1017 + + IMPORTANT NOTE: This tag breaks the SCT test on derecho (see below) as it does not bring in the update to ccs_config_cesm0.0.99 + The reason to do this is that this change will be available for the next CESM alpha tag starting today. + In order to not hold up the CESM alpha tag sequence, we do not have time to run the full regression test suite + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume, katec, cacraig + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + M cime_config/SystemTests/sct.py + +TESTING NOTES: Due to time constraints, only the SCT tests were run + +derecho/intel/aux_cam: Only SCT test was run: + SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep - Did not even start up with this change when using the + - current ccs_config tag. Error reported in cime-test.o4308193 file: + File "/glade/u/apps/derecho/23.09/opt/._view/dmewvyohndr7lajyom5grftguonqfbdr/lib/python3.10/xml/etree/ElementTree.py", line 580, in parse + self._root = parser._parse_whole(source) + xml.etree.ElementTree.ParseError: not well-formed (invalid token): line 1, column 0 + + SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep (Overall: PASS) details: + - When ccs_config_cesm0.0.99 is used, this test PASSES and is BFB + + +izumi/nag/aux_cam: None run + +izumi/gnu/aux_cam: Only two SCT tests were run and they were BFB and ran fine + +=============================================================== +=============================================================== + +Tag name: cam6_3_159 +Originator(s): katetc, andrewgettelman, sjsprecious +Date: April 26, 2024 +One-line Summary: Diagnostic rainbows and new PUMAS external with fixed GPU directives +Github PR URL: https://github.com/ESCOMP/CAM/pull/702 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Add diagnostic rainbow calculation: https://github.com/ESCOMP/CAM/issues/683 + - Partially addresses Broken PUMAS GPU code and GPU regression test: https://github.com/ESCOMP/CAM/issues/1007 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: sjsprecious, andrewgettelman, cacraigucar, nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals_CAM.cgf + - Point to new PUMAS tag + +M cime_config/testdefs/testlist_cam.xml + - Add new test for rainbows output to aux_pumas suite + - Add SCT test to prealpha test suite to ensure it is not broken by the next ccs_config tags + +M cime_config/testdefs/testmods_dir/cam/outfrq9s_pumas_rainbows/shell_comands + cime_config/testdefs/testmods_dir/cam/outfrq9s_pumas_rainbows/user_nl_cam + cime_config/testdefs/testmods_dir/cam/outfrq9s_pumas_rainbows/user_nl_clm + - Added test to the aux_pumas suite to make sure rainbows functionality is maintained + +M src/physics/cam/micro_pumas_cam.F90 + src/physics/cam_dev/micro_pumas_cam.F90 + - Diagnostic rainbows parameterization added identically in both versions of the file. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: all BFB, except: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failure + + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + FAIL SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d BASELINE /glade/campaign/cesm/community/amwg/cam_baselines/cam6_3_158: DIFF + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + FAIL SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h BASELINE /glade/campaign/cesm/community/amwg/cam_baselines/cam6_3_158: DIFF + - Unexpected baseline comparison failures. Documented in ESCOMP/cam issue #1018 + +izumi/nag/aux_cam: all B4B, except: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: all BFB + +Summarize any changes to answers: bit-for-bit unchanged except GEOS-Chem and HEMCO tests described in issue #1018 + +=============================================================== + +Tag name: cam6_3_158 +Originator(s): cacraig +Date: April 22, 2024 +One-line Summary: ZM clean up round 2 for CAM and cime update for GEOS-Chem +Github PR URL: https://github.com/ESCOMP/CAM/pull/992 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - change zm directory to be zhang_mcfarlane: https://github.com/ESCOMP/CAM/issues/965 + - Reimplement writing within ZM and remove pflx variable: https://github.com/ESCOMP/CAM/issues/978 + - ZM cleanup: https://github.com/ESCOMP/CAM/issues/984 + - Tag cam6_3_157 missing updated .gitignore: https://github.com/ESCOMP/CAM/issues/1012 + - GEOS-Chem compsets will fail due to bugs in CAM and CIME: https://github.com/ESCOMP/CAM/issues/1004 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M .gitignore + - Update FV3 listing + +M externals.cfg + - Update cime to bring in bug fix for GEOS-Chem + +M Externals_CAM.cfg + - Update atmospheric_physics external to bring in changes for ZM + +M bld/configure + - Change directory from zm to zhang-mcfarlane + +M src/physics/cam/cam_snapshot.F90 +M src/physics/cam/convect_deep.F90 +M src/physics/cam/physpkg.F90 +M src/physics/cam_dev/cam_snapshot.F90 +M src/physics/cam_dev/physpkg.F90 + - Remove pflx variable which is not used + +M src/physics/cam/zm_conv_intr.F90 + - Split winds into separate variable + - remove pflx + - reintroduce writing within ZM + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: all BFB, except: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failure + + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + - Answer change for HEMCO - approved by Francis and Lizzie due to HEMCO giving different answers when layout changes are made + + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + - no previous baseline + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: all BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_157 +Originator(s): jet +Date: Apr 17, 2024 +One-line Summary: Update FV3 FMS externals, added FV3_CAM interface external, now importing core FV3 from GFDL +Github PR URL: https://github.com/ESCOMP/CAM/pull/983 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update FV3 to allow syncing FMS version with CESM + - Ditch NCAR fork of FV3 in favor of pulling in library code from GFDL + - Clean up FV3 makfile + - Closes issue #950 : FMS external version needs to match version used in CESM + +Describe any changes made to build system: + - Replace FV3 fork external with FV3_interface external that inturn imports FV3 from GFDL + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraig, nusbaume, jedwards + +List all files eliminated: + src/dynamics/fv3/dimensions_mod.F90 + src/dynamics/fv3/dp_coupling.F90 + src/dynamics/fv3/dycore_budget.F90 + src/dynamics/fv3/dycore.F90 + src/dynamics/fv3/dyn_comp.F90 + src/dynamics/fv3/dyn_grid.F90 + src/dynamics/fv3/interp_mod.F90 + src/dynamics/fv3/Makefile.in.fv3 + src/dynamics/fv3/pmgrid.F90 + src/dynamics/fv3/restart_dynamics.F90 + src/dynamics/fv3/spmd_dyn.F90 + src/dynamics/fv3/stepon.F90 + src/dynamics/fv3/microphys/gfdl_cloud_microphys.F90 + src/dynamics/fv3/microphys/module_mp_radar.F90 + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - updated FMS tag +M Externals_CAM.cfg + - removed FV3 fork external and replace with FV3_CAM_INTERFACE external +M bld/configure + - add src_override directory for interfacing GFDL lib code to CAM +M cime_config/bldlib + - add bld_fms target to use common FMS library +M cime_config/config_pes.xml + - update FV3 default C96 PE's for Derecho +M cime_config/testdefs/testlist_cam.xml + - add izumi gnu fv3 test +M cime_config/testdefs/testmods_dirs/cam/outfrq9xs_mg3/shell_commands + - fix C96 PE default for derecho +M test/system/TR8.sh + - add ignore for src_override directory of new FV3_CAM_INTERFACE external + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +All (coupled) jobs had errors about MEMCOMP failing due to missing files - to +be fixed in upcoming CIME tag + +Many tests also had TPUTCOMP errors which are not reported here. The current +working assumption is that there is an error with the test itself not the CAM code. + +derecho/intel/aux_cam: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) details: + - pre-existing failures + + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + - FV3 diff failures are expected due to lack of a baseline file to compare against. + + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: All PASS + +=============================================================== + +Tag name: cam6_3_156 +Originator(s): fvitt +Date: 16 Apr 2024 +One-line Summary: Misc code clean up for WACCM +Github PR URL: https://github.com/ESCOMP/CAM/pull/1001 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Use supported lapack library routine to solve a matrix equation in WACCM physics + efield module (issue #999) + + Misc code clean up in calculations of effective cross section of O2 + + Fix for sd_waccmx_ma_cam6 use case file for waccm_mad_mam5 chemistry + + Minor change to APEX module needed for when NAG compiler '-nan' option is used + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar nusbaume + +List all files eliminated: +D src/chemistry/mozart/sv_decomp.F90 + - remove deprecated matrix solve routines -- replaced by LAPACK DGESV routine + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml + - fix for waccm_mad_mam5 chem + +M src/chemistry/mozart/mo_jshort.F90 + - code clean up in calculations of effective cross section of O2 + +M src/chemistry/utils/apex.F90 + - minor changes for NAG compiler '-nan' option is used + +M src/physics/waccm/efield.F90 + - use LAPACK DGESV routine to solve matrix equation + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + PEND ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 + FAIL SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d + - pre-existing failures + + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s + - pre-existing failure -- should be fixed with an external cime update + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_155 +Originator(s): katec,vlarson,bstephens82,huebleruwm,zarzycki,JulioTBacmeister +Date: April 12, 2024 +One-line Summary: Update CLUBB and SILHS to new UWM external +Github PR URL: https://github.com/ESCOMP/CAM/pull/960 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update to new CLUBB external with some taus code modifications https://github.com/ESCOMP/CAM/issues/956 + - Convert CLUBB lat/lon crash remport from radians to degrees https://github.com/ESCOMP/CAM/issues/971 + - Parameter changes related to optimizing CLUBB's taus code for CESM3 https://github.com/ESCOMP/CAM/issues/953 + +Describe any changes made to build system: + - Modify a test to include threading ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s + - Add CLUBB stats output to an ERP or regular aux_cam test via outfrq9s_mg3 test mods + +Describe any changes made to the namelist: + - Add new fields clubb_bv_efold, clubb_wpxp_Ri_exp, clubb_z_displace to default list + - Add default values and namelist definition entries for many CLUBB namelist fields that were previously missing. + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: cacraig, adamrher, nusbaume, bstephens + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: +M Externals_CAM.cfg + - Point to new tag for CLUBB and SILHS externals + +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cam.xml +M bld/namelist_files/namelist_definition.xml + - New namelist fields for CLUBB plus improved documentation and specified defaults for some older fields + +M cime_config/testdefs/testlist_cam.xml + - Change one test to be multithreaded + +M cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3/user_nl_cam + - Add CLUBB stats history to tests using these mods + +M cime_config/testdefs/testmods_dirs/cam/silhs/user_nl_cam + - Update CLUBB stats history to remove Richardson_num which is no longer output + +M cime_config/usermods_dirs/scam_mandatory/shell_commands + - Update shell redirects + +M src/physics/cam/clubb_intr.F90 +M src/physics/cam/subcol_SILHS.F90 + - Updates to support the new CLUBB and SILHS externals + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +Some tests have namelist changes due to changed stream_datafiles name in ice_in + +derecho/intel/aux_cam: + + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failures + + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) details: + - Current failure, but should be fixed when cime external is next updated + + SMS_Ld5.f09_f09_mg17.PC6.derecho_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + - New namelist fields for cam6 but CLUBB not used in Port compset + + ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000dev.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.f19_f19.F2000dev.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - All tests using CLUBB will see small answer changes + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + - All tests using CLUBB will see small answer changes + +izumi/gnu/aux_cam: + SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp (Overall: NLFAIL) details: + - New namelist fields for cam6 but CLUBB not used in Port compset + + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - All tests using CLUBB will see small answer changes + +CAM tag used for the baseline comparison tests if different than previous +tag: previous tag - cam6_3_154 + +Summarize any changes to answers, i.e., +- what code configurations: All configurations that use CLUBB will see answer changes (cam6 and cam_dev) +- what platforms/compilers: All platforms and compilers +- nature of change (roundoff; larger than roundoff but same climate; new +climate): Larger than roundoff but very similar climate (not verified by ECT) + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced: +- Compare cam6_3_154 to development branch in a 1 year F2000dev f09_f09_mg17 case +- Diagnostics here: https://webext.cgd.ucar.edu/F2000climo/newCLUBBtesting/larson_tag_20231115.katemerge.011124-1252.F2000dev.f09_f09_mg17_1_2_vs_larson_tag_control.cam6_3_145.011124-1252.F2000dev.f09_f09_mg17_1_2/ + + +=============================================================== + +Tag name: cam6_3_154 +Originator(s): megandevlan, jedwards, cacraig +Date: April 4, 2024 +One-line Summary: Update U10 to be resolved wind; add variable for U10+gusts +Github PR URL: https://github.com/ESCOMP/CAM/pull/994 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Remove gustiness term from U10/add new variable with gustiness: https://github.com/ESCOMP/CAM/issues/991 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraig + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - Bring in updated CMEPS and CDEPS to get U10 changes made in CMEPS + +M src/control/camsrfexch.F90 +M src/cpl/nuopc/atm_import_export.F90 +M src/physics/cam/cam_diagnostics.F90 + - Add U10 with gust variables + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +Some tests have namelist changes due to changed stream_datafiles name in ice_in + +derecho/intel/aux_cam: + + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failures + + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) details: + - Current failure, but should be fixed when cime external is next updated + + ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERI_D_Ln18.f45_f45_mg37.QPC41850.derecho_intel.cam-co2rmp_usecase (Overall: DIFF) details: + ERP_D_Ln9.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000dev.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep (Overall: DIFF) details: + SMS_D_Ld2.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.f19_f19.F2000dev.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - Answer changes due to U10 output variable changes + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + ERC_D_Ln9.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) details: + SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + - Answer changes due to U10 output variable changes + +izumi/gnu/aux_cam: + ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) details: + ERI_D_Ln18.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: DIFF) details: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + SMS_D_Ln3.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) details: + SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - Answer changes due to U10 output variable changes + +=============================================================== +=============================================================== + +Tag name: cam6_3_153 +Originator(s): cacraig, hannay, jedwards, lizziel +Date: March 26, 2023 +One-line Summary: Update namelist settings +Github PR URL: https://github.com/ESCOMP/CAM/pull/981 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Bring in namelist settings which Cecile is using for current testing: https://github.com/ESCOMP/CAM/issues/976 + - Remove README_EXTERNALS: https://github.com/ESCOMP/CAM/issues/954 + - fix so that all three flavors of intel compiler are recognized: https://github.com/ESCOMP/CAM/pull/990 + - CAM no longer builds with intel-oneapi compilers: https://github.com/ESCOMP/CAM/issues/988 + - GEOS-Chem compsets will fail due to bugs in CAM and CIME: https://github.com/ESCOMP/CAM/issues/1004 + - This fixes the CAM bug. The CIME bug will be addressed the next time externals are updated. + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: Just change default namelist settings as described below + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume, adamher + +List all files eliminated: +D README_EXTERNALS + - Remove obsolete file (discussed svn externals, which is no longer used) + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M bld/configure + - Fix from Jim to support selecting various intel compilers + +M bld/namelist_files/namelist_defaults_cam.xml + - Change namelist settings to mimic Cecile's settings for cam_dev runs + +M cime_config/buildnml + - Fix typo which prevented GEOS-Chem from finding yml file + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: all BFB except: + + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000dev.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1.f19_f19.F2000dev.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + - Namelist and baseline differences for all cam_dev runs + + + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failures + + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) details: + - Current failure, but should be fixed when cime external is next updated + +izumi/nag/aux_cam: all BFB except + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: all BFB except: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - Namelist and baseline differences for all cam_dev runs + +=============================================================== +=============================================================== +Tag name: cam6_3_152 +Originator(s): pel +Date: Jan 30, 2024 +One-line Summary: "science optimization" for SE-CSLAM and stabilize WACCM +Github PR URL: https://github.com/ESCOMP/CAM/pull/968 + +Increase computational throughput of the SE-CSLAM dynamical core by: + + - Reducing se_nsplit to 2 (from 3) in FMT: CSLAM now runs with ~30% longer time-step compared to baseline + - No double advection of thermodynamic active tracers when using CSLAM. Overwrite GLL values of Q, CLDLIQ, + etc. every vertical remapping time-step with CSLAM values (interpolated from physics grid to GLL grid) + - Vertical sponge layer diffusion in physics for WACCM and WACCM-x + - No increased hyperdiffusion in sponge for FLT and FMT + +Provide stable configuration for WACCM with spectral-elements (ne30-pg3 and ne16pg3): namelist changes + +Resolve qneg issue 864 +Resolve issue 552 (read in topo file on GLL grid if available) +Resolve issue 951 (remove namelist defaults for pg4 grids) +Resolve issue 970 (remove deprecated 'imp' module from buildnml and buildlib) + +Describe any changes made to build system: + + - added namelist variable + - modified 'buildnml' and 'buildlib' python scripts + to remove deprecated 'imp' python module. + +Describe any changes made to the namelist: + + - changed bnd_topo file for ne30-pg3 for reading in topography + on the GLL grid (if available) (issue #552) + - remove namelist defaults for pg4 topo files (issue #951) + - added namelist se_dribble_in_rsplit_loop to stabilize ne16pg3 WACCM + - change se_nsplit, se_rsplit and se_hypervis_subcycle for efficiency/stability + - se_hypervis_subcycle_sponge for efficiency/stability + - change se_nu, se_nu_div and se_sponge_del4_nu_div_fac to stabilize + ne16pg3 WACCM + + +List any changes to the defaults for the boundary datasets: + - new default topo file for ne30pg3 + +Describe any substantial timing or memory changes: + + - approximately 30% speed-up of entire CAM model using COMPSET FLTHIST or FMTHIST + +Code reviewed by: nusbaume, fvitt + +List all existing files that have been modified, and describe the changes: + +M bld/build-namelist + - add namelist variable + +M bld/namelist_files/namelist_defaults_cam.xml + - change defaults (see above) + +M bld/namelist_files/namelist_definition.xml + - add namelist variable + +M cime_config/buildlib +M cime_config/buildnml + - remove deprecated "imp" python module + +M cime_config/testdefs/testlist_cam.xml + - replace ne5pg4 FADIAB test with ne5pg3 test + +M src/dynamics/se/dp_coupling.F90 +M src/dynamics/se/dycore/control_mod.F90 +M src/dynamics/se/dycore/fvm_control_volume_mod.F90 +M src/dynamics/se/dycore/fvm_mapping.F90 +M src/dynamics/se/dycore/fvm_mod.F90 +M src/dynamics/se/dycore/fvm_reconstruction_mod.F90 +M src/dynamics/se/dycore/global_norms_mod.F90 +M src/dynamics/se/dycore/prim_advance_mod.F90 +M src/dynamics/se/dycore/prim_advection_mod.F90 +M src/dynamics/se/dycore/prim_driver_mod.F90 +M src/dynamics/se/dyn_comp.F90 +M src/dynamics/se/dyn_grid.F90 +M src/dynamics/se/dycore_budget.F90 + - implement SE dycore improvements + +M src/dynamics/se/gravity_waves_sources.F90 + - fix model top pressure bug + +M src/physics/cam/vertical_diffusion.F90 + - add vertical sponge layer diffusion + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) + - pre-existing failures + + ERC_D_Ln9.ne16_ne16_mg17.FADIAB.derecho_intel.cam-terminator (Overall: DIFF) + ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) + ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) + ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) + ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.derecho_intel.cam-outfrq3s_refined (Overall: DIFF) + SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) + - expected answer changes + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - pre-existing failure + + ERC_D_Ln9.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) + ERC_D_Ln9.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) + ERI_D_Ln18.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) + ERI_D_Ln18.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) + ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) + ERS_Ln27.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: DIFF) + ERS_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: DIFF) + PEM_D_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: DIFF) + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) + SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) + SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) + SMS_D_Ln9_P1x1.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: DIFF) + - expected answer changes + +izumi/gnu/aux_cam: + + ERC_D_Ln9.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) + ERC_D_Ln9.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) + ERC_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) + ERP_Ln9.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: DIFF) + ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) + PEM_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) + SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) + - expected answer changes + +Summarize any changes to answers: +All spectral-element tests fail due to baseline differences. + + The SE-CSLAM tests fail because of no double-advection + change as well as default hyperviscosity change + The SE (not CSLAM) tests fail because default + hyperviscosity has changed + All WACCM tests fail due to added sponge layer + vertical diffusion + +=============================================================== +=============================================================== + +Tag name: cam6_3_151 +Originator(s): eaton +Date: Thu 21 Mar 2024 +One-line Summary: Bugfix to allow multiple monthly avg history files +Github PR URL: https://github.com/ESCOMP/CAM/pull/1003 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +#1000 - Output of more than 1 monthly average history file is broken. + +. resolves #1000 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraigucar, peverwhee + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +src/control/cam_history.F90 +. subroutine wshist + - add new local variables to store the year, month, and day components of + the time interval midpoint date. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +All tests have a MEMCOMP failure which we are ignoring. +Several tests have a TPUTCOMP failure which we are also ignoring. + +derecho/intel/aux_cam: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: FAIL) details: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + - pre-existing failures + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: + All PASS. + +TESTING NOTE: None of our regression tests use multiple monthly output +files. The fix was tested in a low res FHS94 compset that specified +monthly output for h0, h1, h2, and h3. The 'T' field was output in each +file. A 1 month test was run and all files had identical output. This is +the same configuration that I used to debug the problem. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_150 +Originator(s): megandevlan, peverwhee +Date: Feb 23, 2024 +One-line Summary: Adding convective gustiness to U10: Add UGUST output to CAM +Github PR URL: https://github.com/ESCOMP/CAM/pull/943 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update CMEPS external to bring in gustiness + - Add UGUST output to CAM + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + - can now include 'UGUST' in fincl lists (default: Average flag) + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar, peverwhee + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - Update CMEPS tag to bring in gustiness + +M src/control/camsrfexch.F90 + - Add ugust to cam_in + +M src/cpl/nuopc/atm_import_export.F90 + - Set ugust + +M src/physics/cam/cam_diagnostics.F90 + - Add UGUST addfld/outfld calls + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +All (coupled) jobs had errors about MEMCOMP failing due to missing files - to +be fixed in upcoming CIME tag + +derecho/intel/aux_cam: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) details: + - pre-existing failures + + ERC_D_Ln9.ne16_ne16_mg17.FADIAB.derecho_intel.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9.T42_T42_mg17.FDABIP04.derecho_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9.T42_T42_mg17.FHS94.derecho_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.derecho_intel.cam-outfrq3s_refined (Overall: NLFAIL) details: + SMS_D_Ld5.f19_f19_mg17.PC4.derecho_intel.cam-cam4_port5d (Overall: NLFAIL) details: + SMS_Ld5.f09_f09_mg17.PC6.derecho_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + - add_gusts added to nuopc.runconfig + + ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERI_D_Ln18.f45_f45_mg37.QPC41850.derecho_intel.cam-co2rmp_usecase (Overall: DIFF) details: + ERP_D_Ln9.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000dev.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep (Overall: DIFF) details: + SMS_D_Ld2.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.f19_f19.F2000dev.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - failures due to So_ugustOut in cpl.hi and answer changes for cam_dev tests + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERI_D_Ln18.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERS_Ln27.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ld2.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) details: + SMS_D_Ln9_P1x1.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + TMC_D.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + TMC_D.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + - add_gusts added to nuopc.runconfig + + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + ERC_D_Ln9.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) details: + SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + - failures due to So_ugustOut in cpl.hi + +izumi/gnu/aux_cam: + ERC_D_Ln9.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERP_Ln9.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp (Overall: NLFAIL) details: + - add_gusts added to nuopc.runconfig + + ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) details: + ERI_D_Ln18.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: DIFF) details: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + SMS_D_Ln3.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) details: + SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - failures due to So_ugustOut in cpl.hi and answer changes for cam_dev tests + +=============================================================== +=============================================================== + +Tag name: cam6_3_149 +Originator(s): cacraig, fischer, jedwards +Date: Feb 22, 2024 +One-line Summary: Update externals to match cesm2_3_alpha17a +Github PR URL: https://github.com/ESCOMP/CAM/pull/977 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update externals to match CESM alpha17a tag and the cime external needed to support GEOS-Chem + - Made changes to fix failing regression tests + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - Update externals to match cesm2_3_alpha17a + - Update cime tag to newer one to support GEOS-Chem + +M cime_config/SystemTests/tmc.py + - Fix failing TMC test (due to changes in cime) + +M cime_config/buildnml + - Fix failing GEOS-Chem test (due to changes in externals) + +M cime_config/testdefs/testlist_cam.xml + - Remove obsolete _Vnuopc qualifier on tests + - Introduce a few test types to prealpha testing (they had previously been exclusively tested in aux_cam) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +All jobs had errors about MEMCOMP and TPUTCOMP failing due to missing files (due to changes in externals now making these files) + +derecho/intel/aux_cam: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) details: + - pre-existing failures + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + - Differences due to changed externals + +izumi/nag/aux_cam: All baselines PASS for nag + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: all BFB except: + FAIL SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_148_gnu: DIFF + FAIL SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_148_gnu: DIFF + - Differences due to changed externals + +=============================================================== +=============================================================== + Tag name: cam6_3_148 Originator(s): brianpm, courtneyp, eaton Date: Wed 21 Feb 2024 @@ -149,7 +3794,7 @@ src/physics/rrtmg/ebert_curry.F90 src/physics/rrtmg/oldcloud.F90 src/physics/rrtmg/slingo.F90 . these cloud optics files which can be shared by rrtmg and rrtmgp are - moved to src/physics/cam + moved to src/physics/cam List all files added and what they do: @@ -235,7 +3880,7 @@ src/physics/cam/aerosol_optics_cam.F90 src/physics/cam/phys_prop.F90 . add the public parameter nrh to this module. Was previously in - radconstants. + radconstants. . turn off old debug output to log file src/physics/cam/physpkg.F90 diff --git a/doc/ChangeLog_template b/doc/ChangeLog_template index 5919b4e11a..f646f24e78 100644 --- a/doc/ChangeLog_template +++ b/doc/ChangeLog_template @@ -31,6 +31,8 @@ appropriate machine below. All failed tests must be justified. derecho/intel/aux_cam: +derecho/nvhpc/aux_cam: + izumi/nag/aux_cam: izumi/gnu/aux_cam: diff --git a/libraries/FMS b/libraries/FMS new file mode 160000 index 0000000000..270433531d --- /dev/null +++ b/libraries/FMS @@ -0,0 +1 @@ +Subproject commit 270433531d33c64da7944d80564fe39a84917d26 diff --git a/libraries/mct b/libraries/mct new file mode 160000 index 0000000000..82b0071e69 --- /dev/null +++ b/libraries/mct @@ -0,0 +1 @@ +Subproject commit 82b0071e69d14330b75d23b0bc68543ebea9aadc diff --git a/libraries/parallelio b/libraries/parallelio new file mode 160000 index 0000000000..f52ade0756 --- /dev/null +++ b/libraries/parallelio @@ -0,0 +1 @@ +Subproject commit f52ade075619b32fa141993b5665b0fe099befc2 diff --git a/manage_externals/.dir_locals.el b/manage_externals/.dir_locals.el deleted file mode 100644 index a370490e92..0000000000 --- a/manage_externals/.dir_locals.el +++ /dev/null @@ -1,12 +0,0 @@ -; -*- mode: Lisp -*- - -((python-mode - . ( - ;; fill the paragraph to 80 columns when using M-q - (fill-column . 80) - - ;; Use 4 spaces to indent in Python - (python-indent-offset . 4) - (indent-tabs-mode . nil) - ))) - diff --git a/manage_externals/.github/ISSUE_TEMPLATE.md b/manage_externals/.github/ISSUE_TEMPLATE.md deleted file mode 100644 index 8ecb2ae64b..0000000000 --- a/manage_externals/.github/ISSUE_TEMPLATE.md +++ /dev/null @@ -1,6 +0,0 @@ -### Summary of Issue: -### Expected behavior and actual behavior: -### Steps to reproduce the problem (should include model description file(s) or link to publi c repository): -### What is the changeset ID of the code, and the machine you are using: -### have you modified the code? If so, it must be committed and available for testing: -### Screen output or log file showing the error message and context: diff --git a/manage_externals/.github/PULL_REQUEST_TEMPLATE.md b/manage_externals/.github/PULL_REQUEST_TEMPLATE.md deleted file mode 100644 index b68b1fb5e2..0000000000 --- a/manage_externals/.github/PULL_REQUEST_TEMPLATE.md +++ /dev/null @@ -1,17 +0,0 @@ -[ 50 character, one line summary ] - -[ Description of the changes in this commit. It should be enough - information for someone not following this development to understand. - Lines should be wrapped at about 72 characters. ] - -User interface changes?: [ No/Yes ] -[ If yes, describe what changed, and steps taken to ensure backward compatibilty ] - -Fixes: [Github issue #s] And brief description of each issue. - -Testing: - test removed: - unit tests: - system tests: - manual testing: - diff --git a/manage_externals/.github/workflows/bumpversion.yml b/manage_externals/.github/workflows/bumpversion.yml deleted file mode 100644 index f4dc9b7ca5..0000000000 --- a/manage_externals/.github/workflows/bumpversion.yml +++ /dev/null @@ -1,19 +0,0 @@ -name: Bump version -on: - push: - branches: - - main -jobs: - build: - runs-on: ubuntu-latest - steps: - - uses: actions/checkout@v3 - - name: Bump version and push tag - id: tag_version - uses: mathieudutour/github-tag-action@v5.5 - with: - github_token: ${{ secrets.GITHUB_TOKEN }} - create_annotated_tag: true - default_bump: patch - dry_run: false - tag_prefix: manic- diff --git a/manage_externals/.github/workflows/tests.yml b/manage_externals/.github/workflows/tests.yml deleted file mode 100644 index dd75b91b49..0000000000 --- a/manage_externals/.github/workflows/tests.yml +++ /dev/null @@ -1,30 +0,0 @@ -# This is a workflow to compile the cmeps source without cime -name: Test Manic - -# Controls when the action will run. Triggers the workflow on push or pull request -# events but only for the master branch -on: - push: - branches: [ main ] - pull_request: - branches: [ main ] - -# A workflow run is made up of one or more jobs that can run sequentially or in parallel -jobs: - test-manic: - runs-on: ubuntu-latest - steps: - - uses: actions/checkout@v3 - - name: Test Manic - run: | - pushd test - git config --global user.email "devnull@example.com" - git config --global user.name "GITHUB tester" - git config --global protocol.file.allow always - make utest - make stest - popd - - - name: Setup tmate session - if: ${{ failure() }} - uses: mxschmitt/action-tmate@v3 diff --git a/manage_externals/.gitignore b/manage_externals/.gitignore deleted file mode 100644 index a71ac0cd75..0000000000 --- a/manage_externals/.gitignore +++ /dev/null @@ -1,17 +0,0 @@ -# directories that are checked out by the tool -cime/ -cime_config/ -components/ - -# generated local files -*.log - -# editor files -*~ -*.bak - -# generated python files -*.pyc - -# test tmp file -test/tmp diff --git a/manage_externals/.travis.yml b/manage_externals/.travis.yml deleted file mode 100644 index d9b24c584d..0000000000 --- a/manage_externals/.travis.yml +++ /dev/null @@ -1,18 +0,0 @@ -language: python -os: linux -python: - - "3.4" - - "3.5" - - "3.6" - - "3.7" - - "3.8" -install: - - pip install -r test/requirements.txt -before_script: - - git --version -script: - - cd test; make test - - cd test; make lint -after_success: - - cd test; make coverage - - cd test; coveralls diff --git a/manage_externals/LICENSE.txt b/manage_externals/LICENSE.txt deleted file mode 100644 index 665ee03fbc..0000000000 --- a/manage_externals/LICENSE.txt +++ /dev/null @@ -1,34 +0,0 @@ -Copyright (c) 2017-2018, University Corporation for Atmospheric Research (UCAR) -All rights reserved. - -Developed by: - University Corporation for Atmospheric Research - National Center for Atmospheric Research - https://www2.cesm.ucar.edu/working-groups/sewg - -Permission is hereby granted, free of charge, to any person obtaining -a copy of this software and associated documentation files (the "Software"), -to deal with the Software without restriction, including without limitation -the rights to use, copy, modify, merge, publish, distribute, sublicense, -and/or sell copies of the Software, and to permit persons to whom -the Software is furnished to do so, subject to the following conditions: - - - Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimers. - - Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimers in the documentation - and/or other materials provided with the distribution. - - Neither the names of [Name of Development Group, UCAR], - nor the names of its contributors may be used to endorse or promote - products derived from this Software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE -LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. diff --git a/manage_externals/README.md b/manage_externals/README.md deleted file mode 100644 index 9475301b5d..0000000000 --- a/manage_externals/README.md +++ /dev/null @@ -1,231 +0,0 @@ --- AUTOMATICALLY GENERATED FILE. DO NOT EDIT -- - -[![Build Status](https://travis-ci.org/ESMCI/manage_externals.svg?branch=master)](https://travis-ci.org/ESMCI/manage_externals)[![Coverage Status](https://coveralls.io/repos/github/ESMCI/manage_externals/badge.svg?branch=master)](https://coveralls.io/github/ESMCI/manage_externals?branch=master) -``` -usage: checkout_externals [-h] [-e [EXTERNALS]] [-o] [-S] [-v] [--backtrace] - [-d] [--no-logging] - -checkout_externals manages checking out groups of externals from revision -control based on a externals description file. By default only the -required externals are checkout out. - -Operations performed by manage_externals utilities are explicit and -data driven. checkout_externals will always make the working copy *exactly* -match what is in the externals file when modifying the working copy of -a repository. - -If checkout_externals isn't doing what you expected, double check the contents -of the externals description file. - -Running checkout_externals without the '--status' option will always attempt to -synchronize the working copy to exactly match the externals description. - -optional arguments: - -h, --help show this help message and exit - -e [EXTERNALS], --externals [EXTERNALS] - The externals description filename. Default: - Externals.cfg. - -o, --optional By default only the required externals are checked - out. This flag will also checkout the optional - externals. - -S, --status Output status of the repositories managed by - checkout_externals. By default only summary - information is provided. Use verbose output to see - details. - -v, --verbose Output additional information to the screen and log - file. This flag can be used up to two times, - increasing the verbosity level each time. - --backtrace DEVELOPER: show exception backtraces as extra - debugging output - -d, --debug DEVELOPER: output additional debugging information to - the screen and log file. - --no-logging DEVELOPER: disable logging. - -``` -NOTE: checkout_externals *MUST* be run from the root of the source tree it -is managing. For example, if you cloned a repository with: - - $ git clone git@github.com/{SOME_ORG}/some-project some-project-dev - -Then the root of the source tree is /path/to/some-project-dev. If you -obtained a sub-project via a checkout of another project: - - $ git clone git@github.com/{SOME_ORG}/some-project some-project-dev - -and you need to checkout the sub-project externals, then the root of the -source tree is /path/to/some-project-dev. Do *NOT* run checkout_externals -from within /path/to/some-project-dev/sub-project - -The root of the source tree will be referred to as `${SRC_ROOT}` below. - -# Supported workflows - - * Checkout all required components from the default externals - description file: - - $ cd ${SRC_ROOT} - $ ./manage_externals/checkout_externals - - * To update all required components to the current values in the - externals description file, re-run checkout_externals: - - $ cd ${SRC_ROOT} - $ ./manage_externals/checkout_externals - - If there are *any* modifications to *any* working copy according - to the git or svn 'status' command, checkout_externals - will not update any external repositories. Modifications - include: modified files, added files, removed files, or missing - files. - - To avoid this safety check, edit the externals description file - and comment out the modified external block. - - * Checkout all required components from a user specified externals - description file: - - $ cd ${SRC_ROOT} - $ ./manage_externals/checkout_externals --externals my-externals.cfg - - * Status summary of the repositories managed by checkout_externals: - - $ cd ${SRC_ROOT} - $ ./manage_externals/checkout_externals --status - - ./cime - s ./components/cism - ./components/mosart - e-o ./components/rtm - M ./src/fates - e-o ./tools/PTCLM - - where: - * column one indicates the status of the repository in relation - to the externals description file. - * column two indicates whether the working copy has modified files. - * column three shows how the repository is managed, optional or required - - Column one will be one of these values: - * s : out-of-sync : repository is checked out at a different commit - compared with the externals description - * e : empty : directory does not exist - checkout_externals has not been run - * ? : unknown : directory exists but .git or .svn directories are missing - - Column two will be one of these values: - * M : Modified : modified, added, deleted or missing files - * : blank / space : clean - * - : dash : no meaningful state, for empty repositories - - Column three will be one of these values: - * o : optional : optionally repository - * : blank / space : required repository - - * Detailed git or svn status of the repositories managed by checkout_externals: - - $ cd ${SRC_ROOT} - $ ./manage_externals/checkout_externals --status --verbose - -# Externals description file - - The externals description contains a list of the external - repositories that are used and their version control locations. The - file format is the standard ini/cfg configuration file format. Each - external is defined by a section containing the component name in - square brackets: - - * name (string) : component name, e.g. [cime], [cism], etc. - - Each section has the following keyword-value pairs: - - * required (boolean) : whether the component is a required checkout, - 'true' or 'false'. - - * local_path (string) : component path *relative* to where - checkout_externals is called. - - * protoctol (string) : version control protocol that is used to - manage the component. Valid values are 'git', 'svn', - 'externals_only'. - - Switching an external between different protocols is not - supported, e.g. from svn to git. To switch protocols, you need to - manually move the old working copy to a new location. - - Note: 'externals_only' will only process the external's own - external description file without trying to manage a repository - for the component. This is used for retreiving externals for - standalone components like cam and clm. If the source root of the - externals_only component is the same as the main source root, then - the local path must be set to '.', the unix current working - directory, e. g. 'local_path = .' - - * repo_url (string) : URL for the repository location, examples: - * https://svn-ccsm-models.cgd.ucar.edu/glc - * git@github.com:esmci/cime.git - * /path/to/local/repository - * . - - NOTE: To operate on only the local clone and and ignore remote - repositories, set the url to '.' (the unix current path), - i.e. 'repo_url = .' . This can be used to checkout a local branch - instead of the upstream branch. - - If a repo url is determined to be a local path (not a network url) - then user expansion, e.g. ~/, and environment variable expansion, - e.g. $HOME or $REPO_ROOT, will be performed. - - Relative paths are difficult to get correct, especially for mixed - use repos. It is advised that local paths expand to absolute paths. - If relative paths are used, they should be relative to one level - above local_path. If local path is 'src/foo', the the relative url - should be relative to 'src'. - - * tag (string) : tag to checkout - - * hash (string) : the git hash to checkout. Only applies to git - repositories. - - * branch (string) : branch to checkout from the specified - repository. Specifying a branch on a remote repository means that - checkout_externals will checkout the version of the branch in the remote, - not the the version in the local repository (if it exists). - - Note: one and only one of tag, branch hash must be supplied. - - * externals (string) : used to make manage_externals aware of - sub-externals required by an external. This is a relative path to - the external's root directory. For example, the main externals - description has an external checkout out at 'src/useful_library'. - useful_library requires additional externals to be complete. - Those additional externals are managed from the source root by the - externals description file pointed 'useful_library/sub-xternals.cfg', - Then the main 'externals' field in the top level repo should point to - 'sub-externals.cfg'. - Note that by default, `checkout_externals` will clone an external's - submodules. As a special case, the entry, `externals = None`, will - prevent this behavior. For more control over which externals are - checked out, create an externals file (and see the `from_submodule` - configuration entry below). - - * from_submodule (True / False) : used to pull the repo_url, local_path, - and hash properties for this external from the .gitmodules file in - this repository. Note that the section name (the entry in square - brackets) must match the name in the .gitmodules file. - If from_submodule is True, the protocol must be git and no repo_url, - local_path, hash, branch, or tag entries are allowed. - Default: False - - * sparse (string) : used to control a sparse checkout. This optional - entry should point to a filename (path relative to local_path) that - contains instructions on which repository paths to include (or - exclude) from the working tree. - See the "SPARSE CHECKOUT" section of https://git-scm.com/docs/git-read-tree - Default: sparse checkout is disabled - - * Lines begining with '#' or ';' are comments and will be ignored. - -# Obtaining this tool, reporting issues, etc. - - The master repository for manage_externals is - https://github.com/ESMCI/manage_externals. Any issues with this tool - should be reported there. diff --git a/manage_externals/README_FIRST b/manage_externals/README_FIRST deleted file mode 100644 index c8a47d7806..0000000000 --- a/manage_externals/README_FIRST +++ /dev/null @@ -1,54 +0,0 @@ -CESM is comprised of a number of different components that are -developed and managed independently. Each component may have -additional 'external' dependancies and optional parts that are also -developed and managed independently. - -The checkout_externals.py tool manages retreiving and updating the -components and their externals so you have a complete set of source -files for the model. - -checkout_externals.py relies on a model description file that -describes what components are needed, where to find them and where to -put them in the source tree. The default file is called "CESM.xml" -regardless of whether you are checking out CESM or a standalone -component. - -checkout_externals requires access to git and svn repositories that -require authentication. checkout_externals may pass through -authentication requests, but it will not cache them for you. For the -best and most robust user experience, you should have svn and git -working without password authentication. See: - - https://help.github.com/articles/connecting-to-github-with-ssh/ - - ?svn ref? - -NOTE: checkout_externals.py *MUST* be run from the root of the source -tree it is managing. For example, if you cloned CLM with: - - $ git clone git@github.com/ncar/clm clm-dev - -Then the root of the source tree is /path/to/cesm-dev. If you obtained -CLM via an svn checkout of CESM and you need to checkout the CLM -externals, then the root of the source tree for CLM is: - - /path/to/cesm-dev/components/clm - -The root of the source tree will be referred to as ${SRC_ROOT} below. - -To get started quickly, checkout all required components from the -default model description file: - - $ cd ${SRC_ROOT} - $ ./checkout_cesm/checkout_externals.py - -For additional information about using checkout model, please see: - - ${SRC_ROOT}/checkout_cesm/README - -or run: - - $ cd ${SRC_ROOT} - $ ./checkout_cesm/checkout_externals.py --help - - diff --git a/manage_externals/checkout_externals b/manage_externals/checkout_externals index 48bce24010..ac6b718ee0 100755 --- a/manage_externals/checkout_externals +++ b/manage_externals/checkout_externals @@ -1,36 +1,3 @@ -#!/usr/bin/env python3 - -"""Main driver wrapper around the manic/checkout utility. - -Tool to assemble external respositories represented in an externals -description file. - -""" -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import sys -import traceback - -import manic - -if sys.hexversion < 0x02070000: - print(70 * '*') - print('ERROR: {0} requires python >= 2.7.x. '.format(sys.argv[0])) - print('It appears that you are running python {0}'.format( - '.'.join(str(x) for x in sys.version_info[0:3]))) - print(70 * '*') - sys.exit(1) - - -if __name__ == '__main__': - ARGS = manic.checkout.commandline_arguments() - try: - RET_STATUS, _ = manic.checkout.main(ARGS) - sys.exit(RET_STATUS) - except Exception as error: # pylint: disable=broad-except - manic.printlog(str(error)) - if ARGS.backtrace: - traceback.print_exc() - sys.exit(1) +echo "Error: manage_externals/checkout_externals is no longer supported" +echo " It has been replaced by bin/git-fleximod" +echo " Please refer to the README.md file in the home directory of a CAM checkout for more information" diff --git a/manage_externals/manic/__init__.py b/manage_externals/manic/__init__.py deleted file mode 100644 index 11badedd3b..0000000000 --- a/manage_externals/manic/__init__.py +++ /dev/null @@ -1,9 +0,0 @@ -"""Public API for the manage_externals library -""" - -from manic import checkout -from manic.utils import printlog - -__all__ = [ - 'checkout', 'printlog', -] diff --git a/manage_externals/manic/checkout.py b/manage_externals/manic/checkout.py deleted file mode 100755 index 3f5537adce..0000000000 --- a/manage_externals/manic/checkout.py +++ /dev/null @@ -1,446 +0,0 @@ -#!/usr/bin/env python3 - -""" -Tool to assemble repositories represented in a model-description file. - -If loaded as a module (e.g., in a component's buildcpp), it can be used -to check the validity of existing subdirectories and load missing sources. -""" -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import argparse -import logging -import os -import os.path -import sys - -from manic.externals_description import create_externals_description -from manic.externals_description import read_externals_description_file -from manic.externals_status import check_safe_to_update_repos -from manic.sourcetree import SourceTree -from manic.utils import printlog, fatal_error -from manic.global_constants import VERSION_SEPERATOR, LOG_FILE_NAME - -if sys.hexversion < 0x02070000: - print(70 * '*') - print('ERROR: {0} requires python >= 2.7.x. '.format(sys.argv[0])) - print('It appears that you are running python {0}'.format( - VERSION_SEPERATOR.join(str(x) for x in sys.version_info[0:3]))) - print(70 * '*') - sys.exit(1) - - -# --------------------------------------------------------------------- -# -# User input -# -# --------------------------------------------------------------------- -def commandline_arguments(args=None): - """Process the command line arguments - - Params: args - optional args. Should only be used during systems - testing. - - Returns: processed command line arguments - """ - description = ''' - -%(prog)s manages checking out groups of externals from revision -control based on an externals description file. By default only the -required externals are checkout out. - -Running %(prog)s without the '--status' option will always attempt to -synchronize the working copy to exactly match the externals description. -''' - - epilog = ''' -``` -NOTE: %(prog)s *MUST* be run from the root of the source tree it -is managing. For example, if you cloned a repository with: - - $ git clone git@github.com/{SOME_ORG}/some-project some-project-dev - -Then the root of the source tree is /path/to/some-project-dev. If you -obtained a sub-project via a checkout of another project: - - $ git clone git@github.com/{SOME_ORG}/some-project some-project-dev - -and you need to checkout the sub-project externals, then the root of the -source tree remains /path/to/some-project-dev. Do *NOT* run %(prog)s -from within /path/to/some-project-dev/sub-project - -The root of the source tree will be referred to as `${SRC_ROOT}` below. - - -# Supported workflows - - * Checkout all required components from the default externals - description file: - - $ cd ${SRC_ROOT} - $ ./manage_externals/%(prog)s - - * To update all required components to the current values in the - externals description file, re-run %(prog)s: - - $ cd ${SRC_ROOT} - $ ./manage_externals/%(prog)s - - If there are *any* modifications to *any* working copy according - to the git or svn 'status' command, %(prog)s - will not update any external repositories. Modifications - include: modified files, added files, removed files, or missing - files. - - To avoid this safety check, edit the externals description file - and comment out the modified external block. - - * Checkout all required components from a user specified externals - description file: - - $ cd ${SRC_ROOT} - $ ./manage_externals/%(prog)s --externals my-externals.cfg - - * Status summary of the repositories managed by %(prog)s: - - $ cd ${SRC_ROOT} - $ ./manage_externals/%(prog)s --status - - ./cime - s ./components/cism - ./components/mosart - e-o ./components/rtm - M ./src/fates - e-o ./tools/PTCLM - - - where: - * column one indicates the status of the repository in relation - to the externals description file. - * column two indicates whether the working copy has modified files. - * column three shows how the repository is managed, optional or required - - Column one will be one of these values: - * s : out-of-sync : repository is checked out at a different commit - compared with the externals description - * e : empty : directory does not exist - %(prog)s has not been run - * ? : unknown : directory exists but .git or .svn directories are missing - - Column two will be one of these values: - * M : Modified : modified, added, deleted or missing files - * : blank / space : clean - * - : dash : no meaningful state, for empty repositories - - Column three will be one of these values: - * o : optional : optionally repository - * : blank / space : required repository - - * Detailed git or svn status of the repositories managed by %(prog)s: - - $ cd ${SRC_ROOT} - $ ./manage_externals/%(prog)s --status --verbose - -# Externals description file - - The externals description contains a list of the external - repositories that are used and their version control locations. The - file format is the standard ini/cfg configuration file format. Each - external is defined by a section containing the component name in - square brackets: - - * name (string) : component name, e.g. [cime], [cism], etc. - - Each section has the following keyword-value pairs: - - * required (boolean) : whether the component is a required checkout, - 'true' or 'false'. - - * local_path (string) : component path *relative* to where - %(prog)s is called. - - * protoctol (string) : version control protocol that is used to - manage the component. Valid values are 'git', 'svn', - 'externals_only'. - - Switching an external between different protocols is not - supported, e.g. from svn to git. To switch protocols, you need to - manually move the old working copy to a new location. - - Note: 'externals_only' will only process the external's own - external description file without trying to manage a repository - for the component. This is used for retrieving externals for - standalone components like cam and ctsm which also serve as - sub-components within a larger project. If the source root of the - externals_only component is the same as the main source root, then - the local path must be set to '.', the unix current working - directory, e. g. 'local_path = .' - - * repo_url (string) : URL for the repository location, examples: - * https://svn-ccsm-models.cgd.ucar.edu/glc - * git@github.com:esmci/cime.git - * /path/to/local/repository - * . - - NOTE: To operate on only the local clone and and ignore remote - repositories, set the url to '.' (the unix current path), - i.e. 'repo_url = .' . This can be used to checkout a local branch - instead of the upstream branch. - - If a repo url is determined to be a local path (not a network url) - then user expansion, e.g. ~/, and environment variable expansion, - e.g. $HOME or $REPO_ROOT, will be performed. - - Relative paths are difficult to get correct, especially for mixed - use repos. It is advised that local paths expand to absolute paths. - If relative paths are used, they should be relative to one level - above local_path. If local path is 'src/foo', the the relative url - should be relative to 'src'. - - * tag (string) : tag to checkout - - * hash (string) : the git hash to checkout. Only applies to git - repositories. - - * branch (string) : branch to checkout from the specified - repository. Specifying a branch on a remote repository means that - %(prog)s will checkout the version of the branch in the remote, - not the the version in the local repository (if it exists). - - Note: one and only one of tag, branch hash must be supplied. - - * externals (string) : used to make manage_externals aware of - sub-externals required by an external. This is a relative path to - the external's root directory. For example, if LIBX is often used - as a sub-external, it might have an externals file (for its - externals) called Externals_LIBX.cfg. To use libx as a standalone - checkout, it would have another file, Externals.cfg with the - following entry: - - [ libx ] - local_path = . - protocol = externals_only - externals = Externals_LIBX.cfg - required = True - - Now, %(prog)s will process Externals.cfg and also process - Externals_LIBX.cfg as if it was a sub-external. - - Note that by default, checkout_externals will clone an external's - submodules. As a special case, the entry, "externals = None", will - prevent this behavior. For more control over which externals are - checked out, create an externals file (and see the from_submodule - configuration entry below). - - * from_submodule (True / False) : used to pull the repo_url, local_path, - and hash properties for this external from the .gitmodules file in - this repository. Note that the section name (the entry in square - brackets) must match the name in the .gitmodules file. - If from_submodule is True, the protocol must be git and no repo_url, - local_path, hash, branch, or tag entries are allowed. - Default: False - - * sparse (string) : used to control a sparse checkout. This optional - entry should point to a filename (path relative to local_path) that - contains instructions on which repository paths to include (or - exclude) from the working tree. - See the "SPARSE CHECKOUT" section of https://git-scm.com/docs/git-read-tree - Default: sparse checkout is disabled - - * Lines beginning with '#' or ';' are comments and will be ignored. - -# Obtaining this tool, reporting issues, etc. - - The master repository for manage_externals is - https://github.com/ESMCI/manage_externals. Any issues with this tool - should be reported there. - -# Troubleshooting - -Operations performed by manage_externals utilities are explicit and -data driven. %(prog)s will always attempt to make the working copy -*exactly* match what is in the externals file when modifying the -working copy of a repository. - -If %(prog)s is not doing what you expected, double check the contents -of the externals description file or examine the output of -./manage_externals/%(prog)s --status - -''' - - parser = argparse.ArgumentParser( - description=description, epilog=epilog, - formatter_class=argparse.RawDescriptionHelpFormatter) - - # - # user options - # - parser.add_argument("components", nargs="*", - help="Specific component(s) to checkout. By default, " - "all required externals are checked out.") - - parser.add_argument('-e', '--externals', nargs='?', - default='Externals.cfg', - help='The externals description filename. ' - 'Default: %(default)s.') - - parser.add_argument('-x', '--exclude', nargs='*', - help='Component(s) listed in the externals file which should be ignored.') - - parser.add_argument('-o', '--optional', action='store_true', default=False, - help='By default only the required externals ' - 'are checked out. This flag will also checkout the ' - 'optional externals.') - - parser.add_argument('-S', '--status', action='store_true', default=False, - help='Output the status of the repositories managed by ' - '%(prog)s. By default only summary information ' - 'is provided. Use the verbose option to see details.') - - parser.add_argument('-v', '--verbose', action='count', default=0, - help='Output additional information to ' - 'the screen and log file. This flag can be ' - 'used up to two times, increasing the ' - 'verbosity level each time.') - - parser.add_argument('--svn-ignore-ancestry', action='store_true', default=False, - help='By default, subversion will abort if a component is ' - 'already checked out and there is no common ancestry with ' - 'the new URL. This flag passes the "--ignore-ancestry" flag ' - 'to the svn switch call. (This is not recommended unless ' - 'you are sure about what you are doing.)') - - # - # developer options - # - parser.add_argument('--backtrace', action='store_true', - help='DEVELOPER: show exception backtraces as extra ' - 'debugging output') - - parser.add_argument('-d', '--debug', action='store_true', default=False, - help='DEVELOPER: output additional debugging ' - 'information to the screen and log file.') - - logging_group = parser.add_mutually_exclusive_group() - - logging_group.add_argument('--logging', dest='do_logging', - action='store_true', - help='DEVELOPER: enable logging.') - logging_group.add_argument('--no-logging', dest='do_logging', - action='store_false', default=False, - help='DEVELOPER: disable logging ' - '(this is the default)') - - if args: - options = parser.parse_args(args) - else: - options = parser.parse_args() - return options - -def _dirty_local_repo_msg(program_name, config_file): - return """The external repositories labeled with 'M' above are not in a clean state. -The following are four options for how to proceed: -(1) Go into each external that is not in a clean state and issue either a 'git status' or - an 'svn status' command (depending on whether the external is managed by git or - svn). Either revert or commit your changes so that all externals are in a clean - state. (To revert changes in git, follow the instructions given when you run 'git - status'.) (Note, though, that it is okay to have untracked files in your working - directory.) Then rerun {program_name}. -(2) Alternatively, you do not have to rely on {program_name}. Instead, you can manually - update out-of-sync externals (labeled with 's' above) as described in the - configuration file {config_file}. (For example, run 'git fetch' and 'git checkout' - commands to checkout the appropriate tags for each external, as given in - {config_file}.) -(3) You can also use {program_name} to manage most, but not all externals: You can specify - one or more externals to ignore using the '-x' or '--exclude' argument to - {program_name}. Excluding externals labeled with 'M' will allow {program_name} to - update the other, non-excluded externals. -(4) As a last resort, if you are confident that there is no work that needs to be saved - from a given external, you can remove that external (via "rm -rf [directory]") and - then rerun the {program_name} tool. This option is mainly useful as a workaround for - issues with this tool (such as https://github.com/ESMCI/manage_externals/issues/157). -The external repositories labeled with '?' above are not under version -control using the expected protocol. If you are sure you want to switch -protocols, and you don't have any work you need to save from this -directory, then run "rm -rf [directory]" before rerunning the -{program_name} tool. -""".format(program_name=program_name, config_file=config_file) -# --------------------------------------------------------------------- -# -# main -# -# --------------------------------------------------------------------- -def main(args): - """ - Function to call when module is called from the command line. - Parse externals file and load required repositories or all repositories if - the --all option is passed. - - Returns a tuple (overall_status, tree_status). overall_status is 0 - on success, non-zero on failure. tree_status is a dict mapping local path - to ExternalStatus -- if no checkout is happening. If checkout is happening, tree_status - is None. - """ - if args.do_logging: - logging.basicConfig(filename=LOG_FILE_NAME, - format='%(levelname)s : %(asctime)s : %(message)s', - datefmt='%Y-%m-%d %H:%M:%S', - level=logging.DEBUG) - - program_name = os.path.basename(sys.argv[0]) - logging.info('Beginning of %s', program_name) - - load_all = False - if args.optional: - load_all = True - - root_dir = os.path.abspath(os.getcwd()) - model_data = read_externals_description_file(root_dir, args.externals) - ext_description = create_externals_description( - model_data, components=args.components, exclude=args.exclude) - - for comp in args.components: - if comp not in ext_description.keys(): - # Note we can't print out the list of found externals because - # they were filtered in create_externals_description above. - fatal_error( - "No component {} found in {}".format( - comp, args.externals)) - - source_tree = SourceTree(root_dir, ext_description, svn_ignore_ancestry=args.svn_ignore_ancestry) - if args.components: - components_str = 'specified components' - else: - components_str = 'required & optional components' - printlog('Checking local status of ' + components_str + ': ', end='') - tree_status = source_tree.status(print_progress=True) - printlog('') - - if args.status: - # user requested status-only - for comp in sorted(tree_status): - tree_status[comp].log_status_message(args.verbose) - else: - # checkout / update the external repositories. - safe_to_update = check_safe_to_update_repos(tree_status) - if not safe_to_update: - # print status - for comp in sorted(tree_status): - tree_status[comp].log_status_message(args.verbose) - # exit gracefully - printlog('-' * 70) - printlog(_dirty_local_repo_msg(program_name, args.externals)) - printlog('-' * 70) - else: - if not args.components: - source_tree.checkout(args.verbose, load_all) - for comp in args.components: - source_tree.checkout(args.verbose, load_all, load_comp=comp) - printlog('') - # New tree status is unknown, don't return anything. - tree_status = None - - logging.info('%s completed without exceptions.', program_name) - # NOTE(bja, 2017-11) tree status is used by the systems tests - return 0, tree_status diff --git a/manage_externals/manic/externals_description.py b/manage_externals/manic/externals_description.py deleted file mode 100644 index 546e7fdcb4..0000000000 --- a/manage_externals/manic/externals_description.py +++ /dev/null @@ -1,830 +0,0 @@ -#!/usr/bin/env python3 - -"""Model description - -Model description is the representation of the various externals -included in the model. It processes in input data structure, and -converts it into a standard interface that is used by the rest of the -system. - -To maintain backward compatibility, externals description files should -follow semantic versioning rules, http://semver.org/ - - - -""" -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import logging -import os -import os.path -import re - -# ConfigParser in python2 was renamed to configparser in python3. -# In python2, ConfigParser returns byte strings, str, instead of unicode. -# We need unicode to be compatible with xml and json parser and python3. -try: - # python2 - from ConfigParser import SafeConfigParser as config_parser - from ConfigParser import MissingSectionHeaderError - from ConfigParser import NoSectionError, NoOptionError - - USE_PYTHON2 = True - - def config_string_cleaner(text): - """convert strings into unicode - """ - return text.decode('utf-8') -except ImportError: - # python3 - from configparser import ConfigParser as config_parser - from configparser import MissingSectionHeaderError - from configparser import NoSectionError, NoOptionError - - USE_PYTHON2 = False - - def config_string_cleaner(text): - """Python3 already uses unicode strings, so just return the string - without modification. - - """ - return text - -from .utils import printlog, fatal_error, str_to_bool, expand_local_url -from .utils import execute_subprocess -from .global_constants import EMPTY_STR, PPRINTER, VERSION_SEPERATOR - -# -# Globals -# -DESCRIPTION_SECTION = 'externals_description' -VERSION_ITEM = 'schema_version' - - -def read_externals_description_file(root_dir, file_name): - """Read a file containing an externals description and - create its internal representation. - - """ - root_dir = os.path.abspath(root_dir) - msg = 'In directory : {0}'.format(root_dir) - logging.info(msg) - printlog('Processing externals description file : {0} ({1})'.format(file_name, - root_dir)) - - file_path = os.path.join(root_dir, file_name) - if not os.path.exists(file_name): - if file_name.lower() == "none": - msg = ('INTERNAL ERROR: Attempt to read externals file ' - 'from {0} when not configured'.format(file_path)) - else: - msg = ('ERROR: Model description file, "{0}", does not ' - 'exist at path:\n {1}\nDid you run from the root of ' - 'the source tree?'.format(file_name, file_path)) - - fatal_error(msg) - - externals_description = None - if file_name == ExternalsDescription.GIT_SUBMODULES_FILENAME: - externals_description = _read_gitmodules_file(root_dir, file_name) - else: - try: - config = config_parser() - config.read(file_path) - externals_description = config - except MissingSectionHeaderError: - # not a cfg file - pass - - if externals_description is None: - msg = 'Unknown file format!' - fatal_error(msg) - - return externals_description - -class LstripReader(object): - "LstripReader formats .gitmodules files to be acceptable for configparser" - def __init__(self, filename): - with open(filename, 'r') as infile: - lines = infile.readlines() - self._lines = list() - self._num_lines = len(lines) - self._index = 0 - for line in lines: - self._lines.append(line.lstrip()) - - def readlines(self): - """Return all the lines from this object's file""" - return self._lines - - def readline(self, size=-1): - """Format and return the next line or raise StopIteration""" - try: - line = self.next() - except StopIteration: - line = '' - - if (size > 0) and (len(line) < size): - return line[0:size] - - return line - - def __iter__(self): - """Begin an iteration""" - self._index = 0 - return self - - def next(self): - """Return the next line or raise StopIteration""" - if self._index >= self._num_lines: - raise StopIteration - - self._index = self._index + 1 - return self._lines[self._index - 1] - - def __next__(self): - return self.next() - -def git_submodule_status(repo_dir): - """Run the git submodule status command to obtain submodule hashes. - """ - # This function is here instead of GitRepository to avoid a dependency loop - cmd = 'git -C {repo_dir} submodule status'.format( - repo_dir=repo_dir).split() - git_output = execute_subprocess(cmd, output_to_caller=True) - submodules = {} - submods = git_output.split('\n') - for submod in submods: - if submod: - status = submod[0] - items = submod[1:].split(' ') - if len(items) > 2: - tag = items[2] - else: - tag = None - - submodules[items[1]] = {'hash':items[0], 'status':status, 'tag':tag} - - return submodules - -def parse_submodules_desc_section(section_items, file_path): - """Find the path and url for this submodule description""" - path = None - url = None - for item in section_items: - name = item[0].strip().lower() - if name == 'path': - path = item[1].strip() - elif name == 'url': - url = item[1].strip() - elif name == 'branch': - # We do not care about branch since we have a hash - silently ignore - pass - else: - msg = 'WARNING: Ignoring unknown {} property, in {}' - msg = msg.format(item[0], file_path) # fool pylint - logging.warning(msg) - - return path, url - -def _read_gitmodules_file(root_dir, file_name): - # pylint: disable=deprecated-method - # Disabling this check because the method is only used for python2 - # pylint: disable=too-many-locals - # pylint: disable=too-many-branches - # pylint: disable=too-many-statements - """Read a .gitmodules file and convert it to be compatible with an - externals description. - """ - root_dir = os.path.abspath(root_dir) - msg = 'In directory : {0}'.format(root_dir) - logging.info(msg) - - file_path = os.path.join(root_dir, file_name) - if not os.path.exists(file_name): - msg = ('ERROR: submodules description file, "{0}", does not ' - 'exist in dir:\n {1}'.format(file_name, root_dir)) - fatal_error(msg) - - submodules_description = None - externals_description = None - try: - config = config_parser() - if USE_PYTHON2: - config.readfp(LstripReader(file_path), filename=file_name) - else: - config.read_file(LstripReader(file_path), source=file_name) - - submodules_description = config - except MissingSectionHeaderError: - # not a cfg file - pass - - if submodules_description is None: - msg = 'Unknown file format!' - fatal_error(msg) - else: - # Convert the submodules description to an externals description - externals_description = config_parser() - # We need to grab all the commit hashes for this repo - submods = git_submodule_status(root_dir) - for section in submodules_description.sections(): - if section[0:9] == 'submodule': - sec_name = section[9:].strip(' "') - externals_description.add_section(sec_name) - section_items = submodules_description.items(section) - path, url = parse_submodules_desc_section(section_items, - file_path) - - if path is None: - msg = 'Submodule {} missing path'.format(sec_name) - fatal_error(msg) - - if url is None: - msg = 'Submodule {} missing url'.format(sec_name) - fatal_error(msg) - - externals_description.set(sec_name, - ExternalsDescription.PATH, path) - externals_description.set(sec_name, - ExternalsDescription.PROTOCOL, 'git') - externals_description.set(sec_name, - ExternalsDescription.REPO_URL, url) - externals_description.set(sec_name, - ExternalsDescription.REQUIRED, 'True') - if sec_name in submods: - submod_name = sec_name - else: - # The section name does not have to match the path - submod_name = path - - if submod_name in submods: - git_hash = submods[submod_name]['hash'] - externals_description.set(sec_name, - ExternalsDescription.HASH, - git_hash) - else: - emsg = "submodule status has no section, '{}'" - emsg += "\nCheck section names in externals config file" - fatal_error(emsg.format(submod_name)) - - # Required items - externals_description.add_section(DESCRIPTION_SECTION) - externals_description.set(DESCRIPTION_SECTION, VERSION_ITEM, '1.0.0') - - return externals_description - -def create_externals_description( - model_data, model_format='cfg', components=None, exclude=None, parent_repo=None): - """Create the a externals description object from the provided data - - components: list of component names to include, None to include all. If a - name isn't found, it is silently omitted from the return value. - exclude: list of component names to skip. - """ - externals_description = None - if model_format == 'dict': - externals_description = ExternalsDescriptionDict( - model_data, components=components, exclude=exclude) - elif model_format == 'cfg': - major, _, _ = get_cfg_schema_version(model_data) - if major == 1: - externals_description = ExternalsDescriptionConfigV1( - model_data, components=components, exclude=exclude, parent_repo=parent_repo) - else: - msg = ('Externals description file has unsupported schema ' - 'version "{0}".'.format(major)) - fatal_error(msg) - else: - msg = 'Unknown model data format "{0}"'.format(model_format) - fatal_error(msg) - return externals_description - - -def get_cfg_schema_version(model_cfg): - """Extract the major, minor, patch version of the config file schema - - Params: - model_cfg - config parser object containing the externas description data - - Returns: - major = integer major version - minor = integer minor version - patch = integer patch version - """ - semver_str = '' - try: - semver_str = model_cfg.get(DESCRIPTION_SECTION, VERSION_ITEM) - except (NoSectionError, NoOptionError): - msg = ('externals description file must have the required ' - 'section: "{0}" and item "{1}"'.format(DESCRIPTION_SECTION, - VERSION_ITEM)) - fatal_error(msg) - - # NOTE(bja, 2017-11) Assume we don't care about the - # build/pre-release metadata for now! - version_list = re.split(r'[-+]', semver_str) - version_str = version_list[0] - version = version_str.split(VERSION_SEPERATOR) - try: - major = int(version[0].strip()) - minor = int(version[1].strip()) - patch = int(version[2].strip()) - except ValueError: - msg = ('Config file schema version must have integer digits for ' - 'major, minor and patch versions. ' - 'Received "{0}"'.format(version_str)) - fatal_error(msg) - return major, minor, patch - - -class ExternalsDescription(dict): - """Base externals description class that is independent of the user input - format. Different input formats can all be converted to this - representation to provide a consistent represtentation for the - rest of the objects in the system. - - NOTE(bja, 2018-03): do NOT define _schema_major etc at the class - level in the base class. The nested/recursive nature of externals - means different schema versions may be present in a single run! - - All inheriting classes must overwrite: - self._schema_major and self._input_major - self._schema_minor and self._input_minor - self._schema_patch and self._input_patch - - where _schema_x is the supported schema, _input_x is the user - input value. - - """ - # keywords defining the interface into the externals description data; these - # are brought together by the schema below. - EXTERNALS = 'externals' # path to externals file. - BRANCH = 'branch' - SUBMODULE = 'from_submodule' - HASH = 'hash' - NAME = 'name' - PATH = 'local_path' - PROTOCOL = 'protocol' - REPO = 'repo' - REPO_URL = 'repo_url' - REQUIRED = 'required' - TAG = 'tag' - SPARSE = 'sparse' - - PROTOCOL_EXTERNALS_ONLY = 'externals_only' - PROTOCOL_GIT = 'git' - PROTOCOL_SVN = 'svn' - GIT_SUBMODULES_FILENAME = '.gitmodules' - KNOWN_PRROTOCOLS = [PROTOCOL_GIT, PROTOCOL_SVN, PROTOCOL_EXTERNALS_ONLY] - - # v1 xml keywords - _V1_TREE_PATH = 'TREE_PATH' - _V1_ROOT = 'ROOT' - _V1_TAG = 'TAG' - _V1_BRANCH = 'BRANCH' - _V1_REQ_SOURCE = 'REQ_SOURCE' - - # Dictionary keys are component names. The corresponding values are laid out - # according to this schema. - _source_schema = {REQUIRED: True, - PATH: 'string', - EXTERNALS: 'string', - SUBMODULE : True, - REPO: {PROTOCOL: 'string', - REPO_URL: 'string', - TAG: 'string', - BRANCH: 'string', - HASH: 'string', - SPARSE: 'string', - } - } - - def __init__(self, parent_repo=None): - """Convert the xml into a standardized dict that can be used to - construct the source objects - - """ - dict.__init__(self) - - self._schema_major = None - self._schema_minor = None - self._schema_patch = None - self._input_major = None - self._input_minor = None - self._input_patch = None - self._parent_repo = parent_repo - - def _verify_schema_version(self): - """Use semantic versioning rules to verify we can process this schema. - - """ - known = '{0}.{1}.{2}'.format(self._schema_major, - self._schema_minor, - self._schema_patch) - received = '{0}.{1}.{2}'.format(self._input_major, - self._input_minor, - self._input_patch) - - if self._input_major != self._schema_major: - # should never get here, the factory should handle this correctly! - msg = ('DEV_ERROR: version "{0}" parser received ' - 'version "{1}" input.'.format(known, received)) - fatal_error(msg) - - if self._input_minor > self._schema_minor: - msg = ('Incompatible schema version:\n' - ' User supplied schema version "{0}" is too new."\n' - ' Can only process version "{1}" files and ' - 'older.'.format(received, known)) - fatal_error(msg) - - if self._input_patch > self._schema_patch: - # NOTE(bja, 2018-03) ignoring for now... Not clear what - # conditions the test is needed. - pass - - def _check_user_input(self): - """Run a series of checks to attempt to validate the user input and - detect errors as soon as possible. - - NOTE(bja, 2018-03) These checks are called *after* the file is - read. That means the schema check can not occur here. - - Note: the order is important. check_optional will create - optional with null data. run check_data first to ensure - required data was provided correctly by the user. - - """ - self._check_data() - self._check_optional() - self._validate() - - def _check_data(self): - # pylint: disable=too-many-branches,too-many-statements - """Check user supplied data is valid where possible. - """ - for ext_name in self.keys(): - if (self[ext_name][self.REPO][self.PROTOCOL] - not in self.KNOWN_PRROTOCOLS): - msg = 'Unknown repository protocol "{0}" in "{1}".'.format( - self[ext_name][self.REPO][self.PROTOCOL], ext_name) - fatal_error(msg) - - if (self[ext_name][self.REPO][self.PROTOCOL] == - self.PROTOCOL_SVN): - if self.HASH in self[ext_name][self.REPO]: - msg = ('In repo description for "{0}". svn repositories ' - 'may not include the "hash" keyword.'.format( - ext_name)) - fatal_error(msg) - - if ((self[ext_name][self.REPO][self.PROTOCOL] != self.PROTOCOL_GIT) - and (self.SUBMODULE in self[ext_name])): - msg = ('self.SUBMODULE is only supported with {0} protocol, ' - '"{1}" is defined as an {2} repository') - fatal_error(msg.format(self.PROTOCOL_GIT, ext_name, - self[ext_name][self.REPO][self.PROTOCOL])) - - if (self[ext_name][self.REPO][self.PROTOCOL] != - self.PROTOCOL_EXTERNALS_ONLY): - ref_count = 0 - found_refs = '' - if self.TAG in self[ext_name][self.REPO]: - ref_count += 1 - found_refs = '"{0} = {1}", {2}'.format( - self.TAG, self[ext_name][self.REPO][self.TAG], - found_refs) - if self.BRANCH in self[ext_name][self.REPO]: - ref_count += 1 - found_refs = '"{0} = {1}", {2}'.format( - self.BRANCH, self[ext_name][self.REPO][self.BRANCH], - found_refs) - if self.HASH in self[ext_name][self.REPO]: - ref_count += 1 - found_refs = '"{0} = {1}", {2}'.format( - self.HASH, self[ext_name][self.REPO][self.HASH], - found_refs) - if (self.SUBMODULE in self[ext_name] and - self[ext_name][self.SUBMODULE]): - ref_count += 1 - found_refs = '"{0} = {1}", {2}'.format( - self.SUBMODULE, - self[ext_name][self.SUBMODULE], found_refs) - - if ref_count > 1: - msg = 'Model description is over specified! ' - if self.SUBMODULE in self[ext_name]: - msg += ('from_submodule is not compatible with ' - '"tag", "branch", or "hash" ') - else: - msg += (' Only one of "tag", "branch", or "hash" ' - 'may be specified ') - - msg += 'for repo description of "{0}".'.format(ext_name) - msg = '{0}\nFound: {1}'.format(msg, found_refs) - fatal_error(msg) - elif ref_count < 1: - msg = ('Model description is under specified! One of ' - '"tag", "branch", or "hash" must be specified for ' - 'repo description of "{0}"'.format(ext_name)) - fatal_error(msg) - - if (self.REPO_URL not in self[ext_name][self.REPO] and - (self.SUBMODULE not in self[ext_name] or - not self[ext_name][self.SUBMODULE])): - msg = ('Model description is under specified! Must have ' - '"repo_url" in repo ' - 'description for "{0}"'.format(ext_name)) - fatal_error(msg) - - if (self.SUBMODULE in self[ext_name] and - self[ext_name][self.SUBMODULE]): - if self.REPO_URL in self[ext_name][self.REPO]: - msg = ('Model description is over specified! ' - 'from_submodule keyword is not compatible ' - 'with {0} keyword for'.format(self.REPO_URL)) - msg = '{0} repo description of "{1}"'.format(msg, - ext_name) - fatal_error(msg) - - if self.PATH in self[ext_name]: - msg = ('Model description is over specified! ' - 'from_submodule keyword is not compatible with ' - '{0} keyword for'.format(self.PATH)) - msg = '{0} repo description of "{1}"'.format(msg, - ext_name) - fatal_error(msg) - - if self.REPO_URL in self[ext_name][self.REPO]: - url = expand_local_url( - self[ext_name][self.REPO][self.REPO_URL], ext_name) - self[ext_name][self.REPO][self.REPO_URL] = url - - def _check_optional(self): - # pylint: disable=too-many-branches - """Some fields like externals, repo:tag repo:branch are - (conditionally) optional. We don't want the user to be - required to enter them in every externals description file, but - still want to validate the input. Check conditions and add - default values if appropriate. - - """ - submod_desc = None # Only load submodules info once - for field in self: - # truely optional - if self.EXTERNALS not in self[field]: - self[field][self.EXTERNALS] = EMPTY_STR - - # git and svn repos must tags and branches for validation purposes. - if self.TAG not in self[field][self.REPO]: - self[field][self.REPO][self.TAG] = EMPTY_STR - if self.BRANCH not in self[field][self.REPO]: - self[field][self.REPO][self.BRANCH] = EMPTY_STR - if self.HASH not in self[field][self.REPO]: - self[field][self.REPO][self.HASH] = EMPTY_STR - if self.REPO_URL not in self[field][self.REPO]: - self[field][self.REPO][self.REPO_URL] = EMPTY_STR - if self.SPARSE not in self[field][self.REPO]: - self[field][self.REPO][self.SPARSE] = EMPTY_STR - - # from_submodule has a complex relationship with other fields - if self.SUBMODULE in self[field]: - # User wants to use submodule information, is it available? - if self._parent_repo is None: - # No parent == no submodule information - PPRINTER.pprint(self[field]) - msg = 'No parent submodule for "{0}"'.format(field) - fatal_error(msg) - elif self._parent_repo.protocol() != self.PROTOCOL_GIT: - PPRINTER.pprint(self[field]) - msg = 'Parent protocol, "{0}", does not support submodules' - fatal_error(msg.format(self._parent_repo.protocol())) - else: - args = self._repo_config_from_submodule(field, submod_desc) - repo_url, repo_path, ref_hash, submod_desc = args - - if repo_url is None: - msg = ('Cannot checkout "{0}" as a submodule, ' - 'repo not found in {1} file') - fatal_error(msg.format(field, - self.GIT_SUBMODULES_FILENAME)) - # Fill in submodule fields - self[field][self.REPO][self.REPO_URL] = repo_url - self[field][self.REPO][self.HASH] = ref_hash - self[field][self.PATH] = repo_path - - if self[field][self.SUBMODULE]: - # We should get everything from the parent submodule - # configuration. - pass - # No else (from _submodule = False is the default) - else: - # Add the default value (not using submodule information) - self[field][self.SUBMODULE] = False - - def _repo_config_from_submodule(self, field, submod_desc): - """Find the external config information for a repository from - its submodule configuration information. - """ - if submod_desc is None: - repo_path = os.getcwd() # Is this always correct? - submod_file = self._parent_repo.submodules_file(repo_path=repo_path) - if submod_file is None: - msg = ('Cannot checkout "{0}" from submodule information\n' - ' Parent repo, "{1}" does not have submodules') - fatal_error(msg.format(field, self._parent_repo.name())) - - printlog( - 'Processing submodules description file : {0} ({1})'.format( - submod_file, repo_path)) - submod_model_data= _read_gitmodules_file(repo_path, submod_file) - submod_desc = create_externals_description(submod_model_data) - - # Can we find our external? - repo_url = None - repo_path = None - ref_hash = None - for ext_field in submod_desc: - if field == ext_field: - ext = submod_desc[ext_field] - repo_url = ext[self.REPO][self.REPO_URL] - repo_path = ext[self.PATH] - ref_hash = ext[self.REPO][self.HASH] - break - - return repo_url, repo_path, ref_hash, submod_desc - - def _validate(self): - """Validate that the parsed externals description contains all necessary - fields. - - """ - def print_compare_difference(data_a, data_b, loc_a, loc_b): - """Look through the data structures and print the differences. - - """ - for item in data_a: - if item in data_b: - if not isinstance(data_b[item], type(data_a[item])): - printlog(" {item}: {loc} = {val} ({val_type})".format( - item=item, loc=loc_a, val=data_a[item], - val_type=type(data_a[item]))) - printlog(" {item} {loc} = {val} ({val_type})".format( - item=' ' * len(item), loc=loc_b, val=data_b[item], - val_type=type(data_b[item]))) - else: - printlog(" {item}: {loc} = {val} ({val_type})".format( - item=item, loc=loc_a, val=data_a[item], - val_type=type(data_a[item]))) - printlog(" {item} {loc} missing".format( - item=' ' * len(item), loc=loc_b)) - - def validate_data_struct(schema, data): - """Compare a data structure against a schema and validate all required - fields are present. - - """ - is_valid = False - in_ref = True - valid = True - if isinstance(schema, dict) and isinstance(data, dict): - # Both are dicts, recursively verify that all fields - # in schema are present in the data. - for key in schema: - in_ref = in_ref and (key in data) - if in_ref: - valid = valid and ( - validate_data_struct(schema[key], data[key])) - - is_valid = in_ref and valid - else: - # non-recursive structure. verify data and schema have - # the same type. - is_valid = isinstance(data, type(schema)) - - if not is_valid: - printlog(" Unmatched schema and input:") - if isinstance(schema, dict): - print_compare_difference(schema, data, 'schema', 'input') - print_compare_difference(data, schema, 'input', 'schema') - else: - printlog(" schema = {0} ({1})".format( - schema, type(schema))) - printlog(" input = {0} ({1})".format(data, type(data))) - - return is_valid - - for field in self: - valid = validate_data_struct(self._source_schema, self[field]) - if not valid: - PPRINTER.pprint(self._source_schema) - PPRINTER.pprint(self[field]) - msg = 'ERROR: source for "{0}" did not validate'.format(field) - fatal_error(msg) - - -class ExternalsDescriptionDict(ExternalsDescription): - """Create a externals description object from a dictionary using the API - representations. Primarily used to simplify creating model - description files for unit testing. - - """ - - def __init__(self, model_data, components=None, exclude=None): - """Parse a native dictionary into a externals description. - """ - ExternalsDescription.__init__(self) - self._schema_major = 1 - self._schema_minor = 0 - self._schema_patch = 0 - self._input_major = 1 - self._input_minor = 0 - self._input_patch = 0 - self._verify_schema_version() - if components: - for key in list(model_data.keys()): - if key not in components: - del model_data[key] - - if exclude: - for key in list(model_data.keys()): - if key in exclude: - del model_data[key] - - self.update(model_data) - self._check_user_input() - - -class ExternalsDescriptionConfigV1(ExternalsDescription): - """Create a externals description object from a config_parser object, - schema version 1. - - """ - - def __init__(self, model_data, components=None, exclude=None, parent_repo=None): - """Convert the config data into a standardized dict that can be used to - construct the source objects - - components: list of component names to include, None to include all. - exclude: list of component names to skip. - """ - ExternalsDescription.__init__(self, parent_repo=parent_repo) - self._schema_major = 1 - self._schema_minor = 1 - self._schema_patch = 0 - self._input_major, self._input_minor, self._input_patch = \ - get_cfg_schema_version(model_data) - self._verify_schema_version() - self._remove_metadata(model_data) - self._parse_cfg(model_data, components=components, exclude=exclude) - self._check_user_input() - - @staticmethod - def _remove_metadata(model_data): - """Remove the metadata section from the model configuration file so - that it is simpler to look through the file and construct the - externals description. - - """ - model_data.remove_section(DESCRIPTION_SECTION) - - def _parse_cfg(self, cfg_data, components=None, exclude=None): - """Parse a config_parser object into a externals description. - - components: list of component names to include, None to include all. - exclude: list of component names to skip. - """ - def list_to_dict(input_list, convert_to_lower_case=True): - """Convert a list of key-value pairs into a dictionary. - """ - output_dict = {} - for item in input_list: - key = config_string_cleaner(item[0].strip()) - value = config_string_cleaner(item[1].strip()) - if convert_to_lower_case: - key = key.lower() - output_dict[key] = value - return output_dict - - for section in cfg_data.sections(): - name = config_string_cleaner(section.lower().strip()) - if (components and name not in components) or (exclude and name in exclude): - continue - self[name] = {} - self[name].update(list_to_dict(cfg_data.items(section))) - self[name][self.REPO] = {} - loop_keys = self[name].copy().keys() - for item in loop_keys: - if item in self._source_schema: - if isinstance(self._source_schema[item], bool): - self[name][item] = str_to_bool(self[name][item]) - elif item in self._source_schema[self.REPO]: - self[name][self.REPO][item] = self[name][item] - del self[name][item] - else: - msg = ('Invalid input: "{sect}" contains unknown ' - 'item "{item}".'.format(sect=name, item=item)) - fatal_error(msg) diff --git a/manage_externals/manic/externals_status.py b/manage_externals/manic/externals_status.py deleted file mode 100644 index 6bc29e9732..0000000000 --- a/manage_externals/manic/externals_status.py +++ /dev/null @@ -1,164 +0,0 @@ -"""ExternalStatus - -Class to store status and state information about repositories and -create a string representation. - -""" -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -from .global_constants import EMPTY_STR -from .utils import printlog, indent_string -from .global_constants import VERBOSITY_VERBOSE, VERBOSITY_DUMP - - -class ExternalStatus(object): - """Class to represent the status of a given source repository or tree. - - Individual repositories determine their own status in the - Repository objects. This object is just resposible for storing the - information and passing it up to a higher level for reporting or - global decisions. - - There are two states of concern: - - * If the repository is in-sync with the externals description file. - - * If the repostiory working copy is clean and there are no pending - transactions (e.g. add, remove, rename, untracked files). - - """ - # sync_state and clean_state can be one of the following: - DEFAULT = '-' # not set yet (sync_state). clean_state can be this if sync_state is EMPTY. - UNKNOWN = '?' - EMPTY = 'e' - MODEL_MODIFIED = 's' # repo version != externals (sync_state only) - DIRTY = 'M' # repo is dirty (clean_state only) - STATUS_OK = ' ' # repo is clean (clean_state) or matches externals version (sync_state) - STATUS_ERROR = '!' - - # source_type can be one of the following: - OPTIONAL = 'o' - STANDALONE = 's' - MANAGED = ' ' - - def __init__(self): - self.sync_state = self.DEFAULT - self.clean_state = self.DEFAULT - self.source_type = self.DEFAULT - self.path = EMPTY_STR - self.current_version = EMPTY_STR - self.expected_version = EMPTY_STR - self.status_output = EMPTY_STR - - def log_status_message(self, verbosity): - """Write status message to the screen and log file - """ - printlog(self._default_status_message()) - if verbosity >= VERBOSITY_VERBOSE: - printlog(self._verbose_status_message()) - if verbosity >= VERBOSITY_DUMP: - printlog(self._dump_status_message()) - - def __repr__(self): - return self._default_status_message() - - def _default_status_message(self): - """Return the default terse status message string - """ - return '{sync}{clean}{src_type} {path}'.format( - sync=self.sync_state, clean=self.clean_state, - src_type=self.source_type, path=self.path) - - def _verbose_status_message(self): - """Return the verbose status message string - """ - clean_str = self.DEFAULT - if self.clean_state == self.STATUS_OK: - clean_str = 'clean sandbox' - elif self.clean_state == self.DIRTY: - clean_str = 'modified sandbox' - - sync_str = 'on {0}'.format(self.current_version) - if self.sync_state != self.STATUS_OK: - sync_str = '{current} --> {expected}'.format( - current=self.current_version, expected=self.expected_version) - return ' {clean}, {sync}'.format(clean=clean_str, sync=sync_str) - - def _dump_status_message(self): - """Return the dump status message string - """ - return indent_string(self.status_output, 12) - - def safe_to_update(self): - """Report if it is safe to update a repository. Safe is defined as: - - * If a repository is empty, it is safe to update. - - * If a repository exists and has a clean working copy state - with no pending transactions. - - """ - safe_to_update = False - repo_exists = self.exists() - if not repo_exists: - safe_to_update = True - else: - # If the repo exists, it must be in ok or modified - # sync_state. Any other sync_state at this point - # represents a logic error that should have been handled - # before now! - sync_safe = ((self.sync_state == ExternalStatus.STATUS_OK) or - (self.sync_state == ExternalStatus.MODEL_MODIFIED)) - if sync_safe: - # The clean_state must be STATUS_OK to update. Otherwise we - # are dirty or there was a missed error previously. - if self.clean_state == ExternalStatus.STATUS_OK: - safe_to_update = True - return safe_to_update - - def exists(self): - """Determine if the repo exists. This is indicated by: - - * sync_state is not EMPTY - - * if the sync_state is empty, then the valid states for - clean_state are default, empty or unknown. Anything else - and there was probably an internal logic error. - - NOTE(bja, 2017-10) For the moment we are considering a - sync_state of default or unknown to require user intervention, - but we may want to relax this convention. This is probably a - result of a network error or internal logic error but more - testing is needed. - - """ - is_empty = (self.sync_state == ExternalStatus.EMPTY) - clean_valid = ((self.clean_state == ExternalStatus.DEFAULT) or - (self.clean_state == ExternalStatus.EMPTY) or - (self.clean_state == ExternalStatus.UNKNOWN)) - - if is_empty and clean_valid: - exists = False - else: - exists = True - return exists - - -def check_safe_to_update_repos(tree_status): - """Check if *ALL* repositories are in a safe state to update. We don't - want to do a partial update of the repositories then die, leaving - the model in an inconsistent state. - - Note: if there is an update to do, the repositories will by - definiation be out of synce with the externals description, so we - can't use that as criteria for updating. - - """ - safe_to_update = True - for comp in tree_status: - stat = tree_status[comp] - safe_to_update &= stat.safe_to_update() - - return safe_to_update diff --git a/manage_externals/manic/global_constants.py b/manage_externals/manic/global_constants.py deleted file mode 100644 index 0e91cffc90..0000000000 --- a/manage_externals/manic/global_constants.py +++ /dev/null @@ -1,18 +0,0 @@ -"""Globals shared across modules -""" - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import pprint - -EMPTY_STR = '' -LOCAL_PATH_INDICATOR = '.' -VERSION_SEPERATOR = '.' -LOG_FILE_NAME = 'manage_externals.log' -PPRINTER = pprint.PrettyPrinter(indent=4) - -VERBOSITY_DEFAULT = 0 -VERBOSITY_VERBOSE = 1 -VERBOSITY_DUMP = 2 diff --git a/manage_externals/manic/repository.py b/manage_externals/manic/repository.py deleted file mode 100644 index ea4230fb7b..0000000000 --- a/manage_externals/manic/repository.py +++ /dev/null @@ -1,98 +0,0 @@ -"""Base class representation of a repository -""" - -from .externals_description import ExternalsDescription -from .utils import fatal_error -from .global_constants import EMPTY_STR - - -class Repository(object): - """ - Class to represent and operate on a repository description. - """ - - def __init__(self, component_name, repo): - """ - Parse repo externals description - """ - self._name = component_name - self._protocol = repo[ExternalsDescription.PROTOCOL] - self._tag = repo[ExternalsDescription.TAG] - self._branch = repo[ExternalsDescription.BRANCH] - self._hash = repo[ExternalsDescription.HASH] - self._url = repo[ExternalsDescription.REPO_URL] - self._sparse = repo[ExternalsDescription.SPARSE] - - if self._url is EMPTY_STR: - fatal_error('repo must have a URL') - - if ((self._tag is EMPTY_STR) and (self._branch is EMPTY_STR) and - (self._hash is EMPTY_STR)): - fatal_error('{0} repo must have a branch, tag or hash element') - - ref_count = 0 - if self._tag is not EMPTY_STR: - ref_count += 1 - if self._branch is not EMPTY_STR: - ref_count += 1 - if self._hash is not EMPTY_STR: - ref_count += 1 - if ref_count != 1: - fatal_error('repo {0} must have exactly one of ' - 'tag, branch or hash.'.format(self._name)) - - def checkout(self, base_dir_path, repo_dir_name, verbosity, recursive): # pylint: disable=unused-argument - """ - If the repo destination directory exists, ensure it is correct (from - correct URL, correct branch or tag), and possibly update the source. - If the repo destination directory does not exist, checkout the correce - branch or tag. - NB: is include as an argument for compatibility with - git functionality (repository_git.py) - """ - msg = ('DEV_ERROR: checkout method must be implemented in all ' - 'repository classes! {0}'.format(self.__class__.__name__)) - fatal_error(msg) - - def status(self, stat, repo_dir_path): # pylint: disable=unused-argument - """Report the status of the repo - - """ - msg = ('DEV_ERROR: status method must be implemented in all ' - 'repository classes! {0}'.format(self.__class__.__name__)) - fatal_error(msg) - - def submodules_file(self, repo_path=None): - # pylint: disable=no-self-use,unused-argument - """Stub for use by non-git VC systems""" - return None - - def url(self): - """Public access of repo url. - """ - return self._url - - def tag(self): - """Public access of repo tag - """ - return self._tag - - def branch(self): - """Public access of repo branch. - """ - return self._branch - - def hash(self): - """Public access of repo hash. - """ - return self._hash - - def name(self): - """Public access of repo name. - """ - return self._name - - def protocol(self): - """Public access of repo protocol. - """ - return self._protocol diff --git a/manage_externals/manic/repository_factory.py b/manage_externals/manic/repository_factory.py deleted file mode 100644 index 18c73ffc4b..0000000000 --- a/manage_externals/manic/repository_factory.py +++ /dev/null @@ -1,30 +0,0 @@ -"""Factory for creating and initializing the appropriate repository class -""" - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -from .repository_git import GitRepository -from .repository_svn import SvnRepository -from .externals_description import ExternalsDescription -from .utils import fatal_error - - -def create_repository(component_name, repo_info, svn_ignore_ancestry=False): - """Determine what type of repository we have, i.e. git or svn, and - create the appropriate object. - - Can return None (e.g. if protocol is 'externals_only'). - """ - protocol = repo_info[ExternalsDescription.PROTOCOL].lower() - if protocol == 'git': - repo = GitRepository(component_name, repo_info) - elif protocol == 'svn': - repo = SvnRepository(component_name, repo_info, ignore_ancestry=svn_ignore_ancestry) - elif protocol == 'externals_only': - repo = None - else: - msg = 'Unknown repo protocol "{0}"'.format(protocol) - fatal_error(msg) - return repo diff --git a/manage_externals/manic/repository_git.py b/manage_externals/manic/repository_git.py deleted file mode 100644 index adc666cc57..0000000000 --- a/manage_externals/manic/repository_git.py +++ /dev/null @@ -1,849 +0,0 @@ -"""Class for interacting with git repositories -""" - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import copy -import os - -from .global_constants import EMPTY_STR, LOCAL_PATH_INDICATOR -from .global_constants import VERBOSITY_VERBOSE -from .repository import Repository -from .externals_status import ExternalStatus -from .externals_description import ExternalsDescription, git_submodule_status -from .utils import expand_local_url, split_remote_url, is_remote_url -from .utils import fatal_error, printlog -from .utils import execute_subprocess - - -class GitRepository(Repository): - """Class to represent and operate on a repository description. - - For testing purpose, all system calls to git should: - - * be isolated in separate functions with no application logic - * of the form: - - cmd = 'git -C {dirname} ...'.format(dirname=dirname).split() - - value = execute_subprocess(cmd, output_to_caller={T|F}, - status_to_caller={T|F}) - - return value - * be static methods (not rely on self) - * name as _git_subcommand_args(user_args) - - This convention allows easy unit testing of the repository logic - by mocking the specific calls to return predefined results. - - """ - - def __init__(self, component_name, repo): - """ - repo: ExternalsDescription. - """ - Repository.__init__(self, component_name, repo) - self._gitmodules = None - self._submods = None - - # ---------------------------------------------------------------- - # - # Public API, defined by Repository - # - # ---------------------------------------------------------------- - def checkout(self, base_dir_path, repo_dir_name, verbosity, recursive): - """ - If the repo destination directory exists, ensure it is correct (from - correct URL, correct branch or tag), and possibly update the source. - If the repo destination directory does not exist, checkout the correct - branch or tag. - """ - repo_dir_path = os.path.join(base_dir_path, repo_dir_name) - repo_dir_exists = os.path.exists(repo_dir_path) - if (repo_dir_exists and not os.listdir( - repo_dir_path)) or not repo_dir_exists: - self._clone_repo(base_dir_path, repo_dir_name, verbosity) - self._checkout_ref(repo_dir_path, verbosity, recursive) - gmpath = os.path.join(repo_dir_path, - ExternalsDescription.GIT_SUBMODULES_FILENAME) - if os.path.exists(gmpath): - self._gitmodules = gmpath - self._submods = git_submodule_status(repo_dir_path) - else: - self._gitmodules = None - self._submods = None - - def status(self, stat, repo_dir_path): - """ - If the repo destination directory exists, ensure it is correct (from - correct URL, correct branch or tag), and possibly update the source. - If the repo destination directory does not exist, checkout the correct - branch or tag. - """ - self._check_sync(stat, repo_dir_path) - if os.path.exists(repo_dir_path): - self._status_summary(stat, repo_dir_path) - - def submodules_file(self, repo_path=None): - if repo_path is not None: - gmpath = os.path.join(repo_path, - ExternalsDescription.GIT_SUBMODULES_FILENAME) - if os.path.exists(gmpath): - self._gitmodules = gmpath - self._submods = git_submodule_status(repo_path) - - return self._gitmodules - - # ---------------------------------------------------------------- - # - # Internal work functions - # - # ---------------------------------------------------------------- - def _clone_repo(self, base_dir_path, repo_dir_name, verbosity): - """Clones repo_dir_name into base_dir_path. - """ - self._git_clone(self._url, os.path.join(base_dir_path, repo_dir_name), - verbosity=verbosity) - - def _current_ref(self, dirname): - """Determine the *name* associated with HEAD at dirname. - - If we're on a tag, then returns the tag name; otherwise, returns - the current hash. Returns an empty string if no reference can be - determined (e.g., if we're not actually in a git repository). - - If we're on a branch, then the branch name is also included in - the returned string (in addition to the tag / hash). - """ - ref_found = False - - # If we're exactly at a tag, use that as the current ref - tag_found, tag_name = self._git_current_tag(dirname) - if tag_found: - current_ref = tag_name - ref_found = True - - if not ref_found: - # Otherwise, use current hash as the current ref - hash_found, hash_name = self._git_current_hash(dirname) - if hash_found: - current_ref = hash_name - ref_found = True - - if ref_found: - # If we're on a branch, include branch name in current ref - branch_found, branch_name = self._git_current_branch(dirname) - if branch_found: - current_ref = "{} (branch {})".format(current_ref, branch_name) - else: - # If we still can't find a ref, return empty string. This - # can happen if we're not actually in a git repo - current_ref = '' - - return current_ref - - def _check_sync(self, stat, repo_dir_path): - """Determine whether a git repository is in-sync with the model - description. - - Because repos can have multiple remotes, the only criteria is - whether the branch or tag is the same. - - """ - if not os.path.exists(repo_dir_path): - # NOTE(bja, 2017-10) condition should have been determined - # by _Source() object and should never be here! - stat.sync_state = ExternalStatus.STATUS_ERROR - else: - git_dir = os.path.join(repo_dir_path, '.git') - if not os.path.exists(git_dir): - # NOTE(bja, 2017-10) directory exists, but no git repo - # info.... Can't test with subprocess git command - # because git will move up directory tree until it - # finds the parent repo git dir! - stat.sync_state = ExternalStatus.UNKNOWN - else: - self._check_sync_logic(stat, repo_dir_path) - - def _check_sync_logic(self, stat, repo_dir_path): - """Compare the underlying hashes of the currently checkout ref and the - expected ref. - - Output: sets the sync_state as well as the current and - expected ref in the input status object. - - """ - def compare_refs(current_ref, expected_ref): - """Compare the current and expected ref. - - """ - if current_ref == expected_ref: - status = ExternalStatus.STATUS_OK - else: - status = ExternalStatus.MODEL_MODIFIED - return status - - # get the full hash of the current commit - _, current_ref = self._git_current_hash(repo_dir_path) - - if self._branch: - if self._url == LOCAL_PATH_INDICATOR: - expected_ref = self._branch - else: - remote_name = self._remote_name_for_url(self._url, - repo_dir_path) - if not remote_name: - # git doesn't know about this remote. by definition - # this is a modified state. - expected_ref = "unknown_remote/{0}".format(self._branch) - else: - expected_ref = "{0}/{1}".format(remote_name, self._branch) - elif self._hash: - expected_ref = self._hash - elif self._tag: - expected_ref = self._tag - else: - msg = 'In repo "{0}": none of branch, hash or tag are set'.format( - self._name) - fatal_error(msg) - - # record the *names* of the current and expected branches - stat.current_version = self._current_ref(repo_dir_path) - stat.expected_version = copy.deepcopy(expected_ref) - - if current_ref == EMPTY_STR: - stat.sync_state = ExternalStatus.UNKNOWN - else: - # get the underlying hash of the expected ref - revparse_status, expected_ref_hash = self._git_revparse_commit( - expected_ref, repo_dir_path) - if revparse_status: - # We failed to get the hash associated with - # expected_ref. Maybe we should assign this to some special - # status, but for now we're just calling this out-of-sync to - # remain consistent with how this worked before. - stat.sync_state = ExternalStatus.MODEL_MODIFIED - else: - # compare the underlying hashes - stat.sync_state = compare_refs(current_ref, expected_ref_hash) - - @classmethod - def _remote_name_for_url(cls, remote_url, dirname): - """Return the remote name matching remote_url (or None) - - """ - git_output = cls._git_remote_verbose(dirname) - git_output = git_output.splitlines() - for line in git_output: - data = line.strip() - if not data: - continue - data = data.split() - name = data[0].strip() - url = data[1].strip() - if remote_url == url: - return name - return None - - def _create_remote_name(self): - """The url specified in the externals description file was not known - to git. We need to add it, which means adding a unique and - safe name.... - - The assigned name needs to be safe for git to use, e.g. can't - look like a path 'foo/bar' and work with both remote and local paths. - - Remote paths include but are not limited to: git, ssh, https, - github, gitlab, bitbucket, custom server, etc. - - Local paths can be relative or absolute. They may contain - shell variables, e.g. ${REPO_ROOT}/repo_name, or username - expansion, i.e. ~/ or ~someuser/. - - Relative paths must be at least one layer of redirection, i.e. - container/../ext_repo, but may be many layers deep, e.g. - container/../../../../../ext_repo - - NOTE(bja, 2017-11) - - The base name below may not be unique, for example if the - user has local paths like: - - /path/to/my/repos/nice_repo - /path/to/other/repos/nice_repo - - But the current implementation should cover most common - use cases for remotes and still provide usable names. - - """ - url = copy.deepcopy(self._url) - if is_remote_url(url): - url = split_remote_url(url) - else: - url = expand_local_url(url, self._name) - url = url.split('/') - repo_name = url[-1] - base_name = url[-2] - # repo name should nominally already be something that git can - # deal with. We need to remove other possibly troublesome - # punctuation, e.g. /, $, from the base name. - unsafe_characters = '!@#$%^&*()[]{}\\/,;~' - for unsafe in unsafe_characters: - base_name = base_name.replace(unsafe, '') - remote_name = "{0}_{1}".format(base_name, repo_name) - return remote_name - - def _checkout_ref(self, repo_dir, verbosity, submodules): - """Checkout the user supplied reference - if is True, recursively initialize and update - the repo's submodules - """ - # import pdb; pdb.set_trace() - if self._url.strip() == LOCAL_PATH_INDICATOR: - self._checkout_local_ref(verbosity, submodules, repo_dir) - else: - self._checkout_external_ref(verbosity, submodules, repo_dir) - - if self._sparse: - self._sparse_checkout(repo_dir, verbosity) - - - def _checkout_local_ref(self, verbosity, submodules, dirname): - """Checkout the reference considering the local repo only. Do not - fetch any additional remotes or specify the remote when - checkout out the ref. - if is True, recursively initialize and update - the repo's submodules - """ - if self._tag: - ref = self._tag - elif self._branch: - ref = self._branch - else: - ref = self._hash - - self._check_for_valid_ref(ref, remote_name=None, - dirname=dirname) - self._git_checkout_ref(ref, verbosity, submodules, dirname) - - def _checkout_external_ref(self, verbosity, submodules, dirname): - """Checkout the reference from a remote repository into dirname. - if is True, recursively initialize and update - the repo's submodules. - Note that this results in a 'detached HEAD' state if checking out - a branch, because we check out the remote branch rather than the - local. See https://github.com/ESMCI/manage_externals/issues/34 for - more discussion. - """ - if self._tag: - ref = self._tag - elif self._branch: - ref = self._branch - else: - ref = self._hash - - remote_name = self._remote_name_for_url(self._url, dirname) - if not remote_name: - remote_name = self._create_remote_name() - self._git_remote_add(remote_name, self._url, dirname) - self._git_fetch(remote_name, dirname) - - # NOTE(bja, 2018-03) we need to send separate ref and remote - # name to check_for_vaild_ref, but the combined name to - # checkout_ref! - self._check_for_valid_ref(ref, remote_name, dirname) - - if self._branch: - # Prepend remote name to branch. This means we avoid various - # special cases if the local branch is not tracking the remote or - # cannot be trivially fast-forwarded to match; but, it also - # means we end up in a 'detached HEAD' state. - ref = '{0}/{1}'.format(remote_name, ref) - self._git_checkout_ref(ref, verbosity, submodules, dirname) - - def _sparse_checkout(self, repo_dir, verbosity): - """Use git read-tree to thin the working tree.""" - cmd = ['cp', os.path.join(repo_dir, self._sparse), - os.path.join(repo_dir, - '.git/info/sparse-checkout')] - if verbosity >= VERBOSITY_VERBOSE: - printlog(' {0}'.format(' '.join(cmd))) - execute_subprocess(cmd) - self._git_sparse_checkout(verbosity, repo_dir) - - def _check_for_valid_ref(self, ref, remote_name, dirname): - """Try some basic sanity checks on the user supplied reference so we - can provide a more useful error message than calledprocess - error... - - remote_name can be NOne - """ - is_tag = self._ref_is_tag(ref, dirname) - is_branch = self._ref_is_branch(ref, remote_name, dirname) - is_hash = self._ref_is_hash(ref, dirname) - - is_valid = is_tag or is_branch or is_hash - if not is_valid: - msg = ('In repo "{0}": reference "{1}" does not appear to be a ' - 'valid tag, branch or hash! Please verify the reference ' - 'name (e.g. spelling), is available from: {2} '.format( - self._name, ref, self._url)) - fatal_error(msg) - - if is_tag: - is_unique_tag, msg = self._is_unique_tag(ref, remote_name, - dirname) - if not is_unique_tag: - msg = ('In repo "{0}": tag "{1}" {2}'.format( - self._name, self._tag, msg)) - fatal_error(msg) - - return is_valid - - def _is_unique_tag(self, ref, remote_name, dirname): - """Verify that a reference is a valid tag and is unique (not a branch) - - Tags may be tag names, or SHA id's. It is also possible that a - branch and tag have the some name. - - Note: values returned by git_showref_* and git_revparse are - shell return codes, which are zero for success, non-zero for - error! - - """ - is_tag = self._ref_is_tag(ref, dirname) - is_branch = self._ref_is_branch(ref, remote_name, dirname) - is_hash = self._ref_is_hash(ref, dirname) - - msg = '' - is_unique_tag = False - if is_tag and not is_branch: - # unique tag - msg = 'is ok' - is_unique_tag = True - elif is_tag and is_branch: - msg = ('is both a branch and a tag. git may checkout the branch ' - 'instead of the tag depending on your version of git.') - is_unique_tag = False - elif not is_tag and is_branch: - msg = ('is a branch, and not a tag. If you intended to checkout ' - 'a branch, please change the externals description to be ' - 'a branch. If you intended to checkout a tag, it does not ' - 'exist. Please check the name.') - is_unique_tag = False - else: # not is_tag and not is_branch: - if is_hash: - # probably a sha1 or HEAD, etc, we call it a tag - msg = 'is ok' - is_unique_tag = True - else: - # undetermined state. - msg = ('does not appear to be a valid tag, branch or hash! ' - 'Please check the name and repository.') - is_unique_tag = False - - return is_unique_tag, msg - - def _ref_is_tag(self, ref, dirname): - """Verify that a reference is a valid tag according to git. - - Note: values returned by git_showref_* and git_revparse are - shell return codes, which are zero for success, non-zero for - error! - """ - is_tag = False - value = self._git_showref_tag(ref, dirname) - if value == 0: - is_tag = True - return is_tag - - def _ref_is_branch(self, ref, remote_name, dirname): - """Verify if a ref is any kind of branch (local, tracked remote, - untracked remote). - - remote_name can be None. - """ - local_branch = False - remote_branch = False - if remote_name: - remote_branch = self._ref_is_remote_branch(ref, remote_name, - dirname) - local_branch = self._ref_is_local_branch(ref, dirname) - - is_branch = False - if local_branch or remote_branch: - is_branch = True - return is_branch - - def _ref_is_local_branch(self, ref, dirname): - """Verify that a reference is a valid branch according to git. - - show-ref branch returns local branches that have been - previously checked out. It will not necessarily pick up - untracked remote branches. - - Note: values returned by git_showref_* and git_revparse are - shell return codes, which are zero for success, non-zero for - error! - - """ - is_branch = False - value = self._git_showref_branch(ref, dirname) - if value == 0: - is_branch = True - return is_branch - - def _ref_is_remote_branch(self, ref, remote_name, dirname): - """Verify that a reference is a valid branch according to git. - - show-ref branch returns local branches that have been - previously checked out. It will not necessarily pick up - untracked remote branches. - - Note: values returned by git_showref_* and git_revparse are - shell return codes, which are zero for success, non-zero for - error! - - """ - is_branch = False - value = self._git_lsremote_branch(ref, remote_name, dirname) - if value == 0: - is_branch = True - return is_branch - - def _ref_is_commit(self, ref, dirname): - """Verify that a reference is a valid commit according to git. - - This could be a tag, branch, sha1 id, HEAD and potentially others... - - Note: values returned by git_showref_* and git_revparse are - shell return codes, which are zero for success, non-zero for - error! - """ - is_commit = False - value, _ = self._git_revparse_commit(ref, dirname) - if value == 0: - is_commit = True - return is_commit - - def _ref_is_hash(self, ref, dirname): - """Verify that a reference is a valid hash according to git. - - Git doesn't seem to provide an exact way to determine if user - supplied reference is an actual hash. So we verify that the - ref is a valid commit and return the underlying commit - hash. Then check that the commit hash begins with the user - supplied string. - - Note: values returned by git_showref_* and git_revparse are - shell return codes, which are zero for success, non-zero for - error! - - """ - is_hash = False - status, git_output = self._git_revparse_commit(ref, dirname) - if status == 0: - if git_output.strip().startswith(ref): - is_hash = True - return is_hash - - def _status_summary(self, stat, repo_dir_path): - """Determine the clean/dirty status of a git repository - - """ - git_output = self._git_status_porcelain_v1z(repo_dir_path) - is_dirty = self._status_v1z_is_dirty(git_output) - if is_dirty: - stat.clean_state = ExternalStatus.DIRTY - else: - stat.clean_state = ExternalStatus.STATUS_OK - - # Now save the verbose status output incase the user wants to - # see it. - stat.status_output = self._git_status_verbose(repo_dir_path) - - @staticmethod - def _status_v1z_is_dirty(git_output): - """Parse the git status output from --porcelain=v1 -z and determine if - the repo status is clean or dirty. Dirty means: - - * modified files - * missing files - * added files - * removed - * renamed - * unmerged - - Whether untracked files are considered depends on how the status - command was run (i.e., whether it was run with the '-u' option). - - NOTE: Based on the above definition, the porcelain status - should be an empty string to be considered 'clean'. Of course - this assumes we only get an empty string from an status - command on a clean checkout, and not some error - condition... Could alse use 'git diff --quiet'. - - """ - is_dirty = False - if git_output: - is_dirty = True - return is_dirty - - # ---------------------------------------------------------------- - # - # system call to git for information gathering - # - # ---------------------------------------------------------------- - @staticmethod - def _git_current_hash(dirname): - """Return the full hash of the currently checked-out version. - - Returns a tuple, (hash_found, hash), where hash_found is a - logical specifying whether a hash was found for HEAD (False - could mean we're not in a git repository at all). (If hash_found - is False, then hash is ''.) - """ - status, git_output = GitRepository._git_revparse_commit("HEAD", - dirname) - hash_found = not status - if not hash_found: - git_output = '' - return hash_found, git_output - - @staticmethod - def _git_current_remote_branch(dirname): - """Determines the name of the current remote branch, if any. - - if dir is None, uses the cwd. - - Returns a tuple, (branch_found, branch_name), where branch_found - is a bool specifying whether a branch name was found for - HEAD. (If branch_found is False, then branch_name is ''). - branch_name is in the format '$remote/$branch', e.g. 'origin/foo'. - """ - branch_found = False - branch_name = '' - - cmd = 'git -C {dirname} log -n 1 --pretty=%d HEAD'.format( - dirname=dirname).split() - status, git_output = execute_subprocess(cmd, - output_to_caller=True, - status_to_caller=True) - branch_found = 'HEAD,' in git_output - if branch_found: - # git_output is of the form " (HEAD, origin/blah)" - branch_name = git_output.split(',')[1].strip()[:-1] - return branch_found, branch_name - - @staticmethod - def _git_current_branch(dirname): - """Determines the name of the current local branch. - - Returns a tuple, (branch_found, branch_name), where branch_found - is a bool specifying whether a branch name was found for - HEAD. (If branch_found is False, then branch_name is ''.) - Note that currently we check out the remote branch rather than - the local, so this command does not return the just-checked-out - branch. See _git_current_remote_branch. - """ - cmd = 'git -C {dirname} symbolic-ref --short -q HEAD'.format( - dirname=dirname).split() - status, git_output = execute_subprocess(cmd, - output_to_caller=True, - status_to_caller=True) - branch_found = not status - if branch_found: - git_output = git_output.strip() - else: - git_output = '' - return branch_found, git_output - - @staticmethod - def _git_current_tag(dirname): - """Determines the name tag corresponding to HEAD (if any). - - if dirname is None, uses the cwd. - - Returns a tuple, (tag_found, tag_name), where tag_found is a - bool specifying whether we found a tag name corresponding to - HEAD. (If tag_found is False, then tag_name is ''.) - """ - cmd = 'git -C {dirname} describe --exact-match --tags HEAD'.format( - dirname=dirname).split() - status, git_output = execute_subprocess(cmd, - output_to_caller=True, - status_to_caller=True) - tag_found = not status - if tag_found: - git_output = git_output.strip() - else: - git_output = '' - return tag_found, git_output - - @staticmethod - def _git_showref_tag(ref, dirname): - """Run git show-ref check if the user supplied ref is a tag. - - could also use git rev-parse --quiet --verify tagname^{tag} - """ - cmd = ('git -C {dirname} show-ref --quiet --verify refs/tags/{ref}' - .format(dirname=dirname, ref=ref).split()) - status = execute_subprocess(cmd, status_to_caller=True) - return status - - @staticmethod - def _git_showref_branch(ref, dirname): - """Run git show-ref check if the user supplied ref is a local or - tracked remote branch. - - """ - cmd = ('git -C {dirname} show-ref --quiet --verify refs/heads/{ref}' - .format(dirname=dirname, ref=ref).split()) - status = execute_subprocess(cmd, status_to_caller=True) - return status - - @staticmethod - def _git_lsremote_branch(ref, remote_name, dirname): - """Run git ls-remote to check if the user supplied ref is a remote - branch that is not being tracked - - """ - cmd = ('git -C {dirname} ls-remote --exit-code --heads ' - '{remote_name} {ref}').format( - dirname=dirname, remote_name=remote_name, ref=ref).split() - status = execute_subprocess(cmd, status_to_caller=True) - return status - - @staticmethod - def _git_revparse_commit(ref, dirname): - """Run git rev-parse to detect if a reference is a SHA, HEAD or other - valid commit. - - """ - cmd = ('git -C {dirname} rev-parse --quiet --verify {ref}^{commit}' - .format(dirname=dirname, ref=ref, commit='{commit}').split()) - status, git_output = execute_subprocess(cmd, status_to_caller=True, - output_to_caller=True) - git_output = git_output.strip() - return status, git_output - - @staticmethod - def _git_status_porcelain_v1z(dirname): - """Run git status to obtain repository information. - - This is run with '--untracked=no' to ignore untracked files. - - The machine-portable format that is guaranteed not to change - between git versions or *user configuration*. - - """ - cmd = ('git -C {dirname} status --untracked-files=no --porcelain -z' - .format(dirname=dirname)).split() - git_output = execute_subprocess(cmd, output_to_caller=True) - return git_output - - @staticmethod - def _git_status_verbose(dirname): - """Run the git status command to obtain repository information. - """ - cmd = 'git -C {dirname} status'.format(dirname=dirname).split() - git_output = execute_subprocess(cmd, output_to_caller=True) - return git_output - - @staticmethod - def _git_remote_verbose(dirname): - """Run the git remote command to obtain repository information. - - Returned string is of the form: - myfork git@github.com:johnpaulalex/manage_externals_jp.git (fetch) - myfork git@github.com:johnpaulalex/manage_externals_jp.git (push) - """ - cmd = 'git -C {dirname} remote --verbose'.format( - dirname=dirname).split() - return execute_subprocess(cmd, output_to_caller=True) - - @staticmethod - def has_submodules(repo_dir_path): - """Return True iff the repository at has a - '.gitmodules' file - """ - fname = os.path.join(repo_dir_path, - ExternalsDescription.GIT_SUBMODULES_FILENAME) - - return os.path.exists(fname) - - # ---------------------------------------------------------------- - # - # system call to git for sideffects modifying the working tree - # - # ---------------------------------------------------------------- - @staticmethod - def _git_clone(url, repo_dir_name, verbosity): - """Clones url into repo_dir_name. - """ - cmd = 'git clone --quiet {url} {repo_dir_name}'.format( - url=url, repo_dir_name=repo_dir_name).split() - if verbosity >= VERBOSITY_VERBOSE: - printlog(' {0}'.format(' '.join(cmd))) - execute_subprocess(cmd) - - @staticmethod - def _git_remote_add(name, url, dirname): - """Run the git remote command for the side effect of adding a remote - """ - cmd = 'git -C {dirname} remote add {name} {url}'.format( - dirname=dirname, name=name, url=url).split() - execute_subprocess(cmd) - - @staticmethod - def _git_fetch(remote_name, dirname): - """Run the git fetch command for the side effect of updating the repo - """ - cmd = 'git -C {dirname} fetch --quiet --tags {remote_name}'.format( - dirname=dirname, remote_name=remote_name).split() - execute_subprocess(cmd) - - @staticmethod - def _git_checkout_ref(ref, verbosity, submodules, dirname): - """Run the git checkout command for the side effect of updating the repo - - Param: ref is a reference to a local or remote object in the - form 'origin/my_feature', or 'tag1'. - - """ - cmd = 'git -C {dirname} checkout --quiet {ref}'.format( - dirname=dirname, ref=ref).split() - if verbosity >= VERBOSITY_VERBOSE: - printlog(' {0}'.format(' '.join(cmd))) - execute_subprocess(cmd) - if submodules: - GitRepository._git_update_submodules(verbosity, dirname) - - @staticmethod - def _git_sparse_checkout(verbosity, dirname): - """Configure repo via read-tree.""" - cmd = 'git -C {dirname} config core.sparsecheckout true'.format( - dirname=dirname).split() - if verbosity >= VERBOSITY_VERBOSE: - printlog(' {0}'.format(' '.join(cmd))) - execute_subprocess(cmd) - cmd = 'git -C {dirname} read-tree -mu HEAD'.format( - dirname=dirname).split() - if verbosity >= VERBOSITY_VERBOSE: - printlog(' {0}'.format(' '.join(cmd))) - execute_subprocess(cmd) - - @staticmethod - def _git_update_submodules(verbosity, dirname): - """Run git submodule update for the side effect of updating this - repo's submodules. - """ - # First, verify that we have a .gitmodules file - if os.path.exists( - os.path.join(dirname, - ExternalsDescription.GIT_SUBMODULES_FILENAME)): - cmd = ('git -C {dirname} submodule update --init --recursive' - .format(dirname=dirname)).split() - if verbosity >= VERBOSITY_VERBOSE: - printlog(' {0}'.format(' '.join(cmd))) - - execute_subprocess(cmd) diff --git a/manage_externals/manic/repository_svn.py b/manage_externals/manic/repository_svn.py deleted file mode 100644 index 922855d34e..0000000000 --- a/manage_externals/manic/repository_svn.py +++ /dev/null @@ -1,288 +0,0 @@ -"""Class for interacting with svn repositories -""" - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import os -import re -import xml.etree.ElementTree as ET - -from .global_constants import EMPTY_STR, VERBOSITY_VERBOSE -from .repository import Repository -from .externals_status import ExternalStatus -from .utils import fatal_error, indent_string, printlog -from .utils import execute_subprocess - - -class SvnRepository(Repository): - """ - Class to represent and operate on a repository description. - - For testing purpose, all system calls to svn should: - - * be isolated in separate functions with no application logic - * of the form: - - cmd = ['svn', ...] - - value = execute_subprocess(cmd, output_to_caller={T|F}, - status_to_caller={T|F}) - - return value - * be static methods (not rely on self) - * name as _svn_subcommand_args(user_args) - - This convention allows easy unit testing of the repository logic - by mocking the specific calls to return predefined results. - - """ - RE_URLLINE = re.compile(r'^URL:') - - def __init__(self, component_name, repo, ignore_ancestry=False): - """ - Parse repo (a XML element). - """ - Repository.__init__(self, component_name, repo) - self._ignore_ancestry = ignore_ancestry - if self._url.endswith('/'): - # there is already a '/' separator in the URL; no need to add another - url_sep = '' - else: - url_sep = '/' - if self._branch: - self._url = self._url + url_sep + self._branch - elif self._tag: - self._url = self._url + url_sep + self._tag - else: - msg = "DEV_ERROR in svn repository. Shouldn't be here!" - fatal_error(msg) - - # ---------------------------------------------------------------- - # - # Public API, defined by Repository - # - # ---------------------------------------------------------------- - def checkout(self, base_dir_path, repo_dir_name, verbosity, recursive): # pylint: disable=unused-argument - """Checkout or update the working copy - - If the repo destination directory exists, switch the sandbox to - match the externals description. - - If the repo destination directory does not exist, checkout the - correct branch or tag. - NB: is include as an argument for compatibility with - git functionality (repository_git.py) - - """ - repo_dir_path = os.path.join(base_dir_path, repo_dir_name) - if os.path.exists(repo_dir_path): - cwd = os.getcwd() - os.chdir(repo_dir_path) - self._svn_switch(self._url, self._ignore_ancestry, verbosity) - # svn switch can lead to a conflict state, but it gives a - # return code of 0. So now we need to make sure that we're - # in a clean (non-conflict) state. - self._abort_if_dirty(repo_dir_path, - "Expected clean state following switch") - os.chdir(cwd) - else: - self._svn_checkout(self._url, repo_dir_path, verbosity) - - def status(self, stat, repo_dir_path): - """ - Check and report the status of the repository - """ - self._check_sync(stat, repo_dir_path) - if os.path.exists(repo_dir_path): - self._status_summary(stat, repo_dir_path) - - # ---------------------------------------------------------------- - # - # Internal work functions - # - # ---------------------------------------------------------------- - def _check_sync(self, stat, repo_dir_path): - """Check to see if repository directory exists and is at the expected - url. Return: status object - - """ - if not os.path.exists(repo_dir_path): - # NOTE(bja, 2017-10) this state should have been handled by - # the source object and we never get here! - stat.sync_state = ExternalStatus.STATUS_ERROR - else: - svn_output = self._svn_info(repo_dir_path) - if not svn_output: - # directory exists, but info returned nothing. .svn - # directory removed or incomplete checkout? - stat.sync_state = ExternalStatus.UNKNOWN - else: - stat.sync_state, stat.current_version = \ - self._check_url(svn_output, self._url) - stat.expected_version = '/'.join(self._url.split('/')[3:]) - - def _abort_if_dirty(self, repo_dir_path, message): - """Check if the repo is in a dirty state; if so, abort with a - helpful message. - - """ - - stat = ExternalStatus() - self._status_summary(stat, repo_dir_path) - if stat.clean_state != ExternalStatus.STATUS_OK: - status = self._svn_status_verbose(repo_dir_path) - status = indent_string(status, 4) - errmsg = """In directory - {cwd} - -svn status now shows: -{status} - -ERROR: {message} - -One possible cause of this problem is that there may have been untracked -files in your working directory that had the same name as tracked files -in the new revision. - -To recover: Clean up the above directory (resolving conflicts, etc.), -then rerun checkout_externals. -""".format(cwd=repo_dir_path, message=message, status=status) - - fatal_error(errmsg) - - @staticmethod - def _check_url(svn_output, expected_url): - """Determine the svn url from svn info output and return whether it - matches the expected value. - - """ - url = None - for line in svn_output.splitlines(): - if SvnRepository.RE_URLLINE.match(line): - url = line.split(': ')[1].strip() - break - if not url: - status = ExternalStatus.UNKNOWN - elif url == expected_url: - status = ExternalStatus.STATUS_OK - else: - status = ExternalStatus.MODEL_MODIFIED - - if url: - current_version = '/'.join(url.split('/')[3:]) - else: - current_version = EMPTY_STR - - return status, current_version - - def _status_summary(self, stat, repo_dir_path): - """Report whether the svn repository is in-sync with the model - description and whether the sandbox is clean or dirty. - - """ - svn_output = self._svn_status_xml(repo_dir_path) - is_dirty = self.xml_status_is_dirty(svn_output) - if is_dirty: - stat.clean_state = ExternalStatus.DIRTY - else: - stat.clean_state = ExternalStatus.STATUS_OK - - # Now save the verbose status output incase the user wants to - # see it. - stat.status_output = self._svn_status_verbose(repo_dir_path) - - @staticmethod - def xml_status_is_dirty(svn_output): - """Parse svn status xml output and determine if the working copy is - clean or dirty. Dirty is defined as: - - * modified files - * added files - * deleted files - * missing files - - Unversioned files do not affect the clean/dirty status. - - 'external' is also an acceptable state - - """ - # pylint: disable=invalid-name - SVN_EXTERNAL = 'external' - SVN_UNVERSIONED = 'unversioned' - # pylint: enable=invalid-name - - is_dirty = False - try: - xml_status = ET.fromstring(svn_output) - except BaseException: - fatal_error( - "SVN returned invalid XML message {}".format(svn_output)) - xml_target = xml_status.find('./target') - entries = xml_target.findall('./entry') - for entry in entries: - status = entry.find('./wc-status') - item = status.get('item') - if item == SVN_EXTERNAL: - continue - if item == SVN_UNVERSIONED: - continue - is_dirty = True - break - return is_dirty - - # ---------------------------------------------------------------- - # - # system call to svn for information gathering - # - # ---------------------------------------------------------------- - @staticmethod - def _svn_info(repo_dir_path): - """Return results of svn info command - """ - cmd = ['svn', 'info', repo_dir_path] - output = execute_subprocess(cmd, output_to_caller=True) - return output - - @staticmethod - def _svn_status_verbose(repo_dir_path): - """capture the full svn status output - """ - cmd = ['svn', 'status', repo_dir_path] - svn_output = execute_subprocess(cmd, output_to_caller=True) - return svn_output - - @staticmethod - def _svn_status_xml(repo_dir_path): - """ - Get status of the subversion sandbox in repo_dir - """ - cmd = ['svn', 'status', '--xml', repo_dir_path] - svn_output = execute_subprocess(cmd, output_to_caller=True) - return svn_output - - # ---------------------------------------------------------------- - # - # system call to svn for sideffects modifying the working tree - # - # ---------------------------------------------------------------- - @staticmethod - def _svn_checkout(url, repo_dir_path, verbosity): - """ - Checkout a subversion repository (repo_url) to checkout_dir. - """ - cmd = ['svn', 'checkout', '--quiet', url, repo_dir_path] - if verbosity >= VERBOSITY_VERBOSE: - printlog(' {0}'.format(' '.join(cmd))) - execute_subprocess(cmd) - - @staticmethod - def _svn_switch(url, ignore_ancestry, verbosity): - """ - Switch branches for in an svn sandbox - """ - cmd = ['svn', 'switch', '--quiet'] - if ignore_ancestry: - cmd.append('--ignore-ancestry') - cmd.append(url) - if verbosity >= VERBOSITY_VERBOSE: - printlog(' {0}'.format(' '.join(cmd))) - execute_subprocess(cmd) diff --git a/manage_externals/manic/sourcetree.py b/manage_externals/manic/sourcetree.py deleted file mode 100644 index cf2a5b7569..0000000000 --- a/manage_externals/manic/sourcetree.py +++ /dev/null @@ -1,425 +0,0 @@ -""" -Classes to represent an externals config file (SourceTree) and the components -within it (_External). -""" - -import errno -import logging -import os - -from .externals_description import ExternalsDescription -from .externals_description import read_externals_description_file -from .externals_description import create_externals_description -from .repository_factory import create_repository -from .repository_git import GitRepository -from .externals_status import ExternalStatus -from .utils import fatal_error, printlog -from .global_constants import EMPTY_STR, LOCAL_PATH_INDICATOR -from .global_constants import VERBOSITY_VERBOSE - -class _External(object): - """ - A single component hosted in an external repository (and any children). - - The component may or may not be checked-out upon construction. - """ - # pylint: disable=R0902 - - def __init__(self, root_dir, name, local_path, required, subexternals_path, - repo, svn_ignore_ancestry, subexternal_sourcetree): - """Create a single external component (checked out or not). - - Input: - root_dir : string - the (checked-out) parent repo's root dir. - local_path : string - this external's (checked-out) subdir relative - to root_dir, e.g. "components/mom" - repo: Repository - the repo object for this external. Can be None (e.g. if this external just refers to another external file). - - name : string - name of this external (as named by the parent - reference). May or may not correspond to something in the path. - - ext_description : dict - source ExternalsDescription object - - svn_ignore_ancestry : bool - use --ignore-externals with svn switch - - subexternals_path: string - path to sub-externals config file, if any. Relative to local_path, or special value 'none'. - subexternal_sourcetree: SourceTree - corresponding to subexternals_path, if subexternals_path exists (it might not, if it is not checked out yet). - """ - self._name = name - self._required = required - - self._stat = None # Populated in status() - - self._local_path = local_path - # _repo_dir_path : full repository directory, e.g. - # "/components/mom" - repo_dir = os.path.join(root_dir, local_path) - self._repo_dir_path = os.path.abspath(repo_dir) - # _base_dir_path : base directory *containing* the repository, e.g. - # "/components" - self._base_dir_path = os.path.dirname(self._repo_dir_path) - # _repo_dir_name : base_dir_path + repo_dir_name = repo_dir_path - # e.g., "mom" - self._repo_dir_name = os.path.basename(self._repo_dir_path) - self._repo = repo - - # Does this component have subcomponents aka an externals config? - self._subexternals_path = subexternals_path - self._subexternal_sourcetree = subexternal_sourcetree - - - def get_name(self): - """ - Return the external object's name - """ - return self._name - - def get_local_path(self): - """ - Return the external object's path - """ - return self._local_path - - def get_repo_dir_path(self): - return self._repo_dir_path - - def get_subexternals_path(self): - return self._subexternals_path - - def get_repo(self): - return self._repo - - def status(self, force=False, print_progress=False): - """ - Returns status of this component and all subcomponents. - - Returns a dict mapping our local path (not component name!) to an - ExternalStatus dict. Any subcomponents will have their own top-level - path keys. Note the return value includes entries for this and all - subcomponents regardless of whether they are locally installed or not. - - Side-effect: If self._stat is empty or force is True, calculates _stat. - """ - calc_stat = force or not self._stat - - if calc_stat: - self._stat = ExternalStatus() - self._stat.path = self.get_local_path() - if not self._required: - self._stat.source_type = ExternalStatus.OPTIONAL - elif self._local_path == LOCAL_PATH_INDICATOR: - # LOCAL_PATH_INDICATOR, '.' paths, are standalone - # component directories that are not managed by - # checkout_subexternals. - self._stat.source_type = ExternalStatus.STANDALONE - else: - # managed by checkout_subexternals - self._stat.source_type = ExternalStatus.MANAGED - - subcomponent_stats = {} - if not os.path.exists(self._repo_dir_path): - if calc_stat: - # No local repository. - self._stat.sync_state = ExternalStatus.EMPTY - msg = ('status check: repository directory for "{0}" does not ' - 'exist.'.format(self._name)) - logging.info(msg) - self._stat.current_version = 'not checked out' - # NOTE(bja, 2018-01) directory doesn't exist, so we cannot - # use repo to determine the expected version. We just take - # a best-guess based on the assumption that only tag or - # branch should be set, but not both. - if not self._repo: - self._stat.expected_version = 'unknown' - else: - self._stat.expected_version = self._repo.tag() + self._repo.branch() - else: - # Merge local repository state (e.g. clean/dirty) into self._stat. - if calc_stat and self._repo: - self._repo.status(self._stat, self._repo_dir_path) - - # Status of subcomponents, if any. - if self._subexternals_path and self._subexternal_sourcetree: - cwd = os.getcwd() - # SourceTree.status() expects to be called from the correct - # root directory. - os.chdir(self._repo_dir_path) - subcomponent_stats = self._subexternal_sourcetree.status(self._local_path, force=force, print_progress=print_progress) - os.chdir(cwd) - - # Merge our status + subcomponent statuses into one return dict keyed - # by component path. - all_stats = {} - # don't add the root component because we don't manage it - # and can't provide useful info about it. - if self._local_path != LOCAL_PATH_INDICATOR: - # store the stats under the local_path, not comp name so - # it will be sorted correctly - all_stats[self._stat.path] = self._stat - - if subcomponent_stats: - all_stats.update(subcomponent_stats) - - return all_stats - - def checkout(self, verbosity): - """ - If the repo destination directory exists, ensure it is correct (from - correct URL, correct branch or tag), and possibly updateit. - If the repo destination directory does not exist, checkout the correct - branch or tag. - Does not check out sub-externals, see SourceTree.checkout(). - """ - # Make sure we are in correct location - if not os.path.exists(self._repo_dir_path): - # repository directory doesn't exist. Need to check it - # out, and for that we need the base_dir_path to exist - try: - os.makedirs(self._base_dir_path) - except OSError as error: - if error.errno != errno.EEXIST: - msg = 'Could not create directory "{0}"'.format( - self._base_dir_path) - fatal_error(msg) - - if not self._stat: - self.status() - assert self._stat - - if self._stat.source_type != ExternalStatus.STANDALONE: - if verbosity >= VERBOSITY_VERBOSE: - # NOTE(bja, 2018-01) probably do not want to pass - # verbosity in this case, because if (verbosity == - # VERBOSITY_DUMP), then the previous status output would - # also be dumped, adding noise to the output. - self._stat.log_status_message(VERBOSITY_VERBOSE) - - if self._repo: - if self._stat.sync_state == ExternalStatus.STATUS_OK: - # If we're already in sync, avoid showing verbose output - # from the checkout command, unless the verbosity level - # is 2 or more. - checkout_verbosity = verbosity - 1 - else: - checkout_verbosity = verbosity - - self._repo.checkout(self._base_dir_path, self._repo_dir_name, - checkout_verbosity, self.clone_recursive()) - - def replace_subexternal_sourcetree(self, sourcetree): - self._subexternal_sourcetree = sourcetree - - def clone_recursive(self): - 'Return True iff any .gitmodules files should be processed' - # Try recursive .gitmodules unless there is an externals entry - recursive = not self._subexternals_path - - return recursive - - -class SourceTree(object): - """ - SourceTree represents a group of managed externals. - - Those externals may not be checked out locally yet, they might only - have Repository objects pointing to their respective repositories. - """ - - @classmethod - def from_externals_file(cls, parent_repo_dir_path, parent_repo, - externals_path): - """Creates a SourceTree representing the given externals file. - - Looks up a git submodules file as an optional backup if there is no - externals file specified. - - Returns None if there is no externals file (i.e. it's None or 'none'), - or if the externals file hasn't been checked out yet. - - parent_repo_dir_path: parent repo root dir - parent_repo: parent repo. - externals_path: path to externals file, relative to parent_repo_dir_path. - """ - if not os.path.exists(parent_repo_dir_path): - # NOTE(bja, 2017-10) repository has not been checked out - # yet, can't process the externals file. Assume we are - # checking status before code is checkoud out and this - # will be handled correctly later. - return None - - if externals_path.lower() == 'none': - # With explicit 'none', do not look for git submodules file. - return None - - cwd = os.getcwd() - os.chdir(parent_repo_dir_path) - - if not externals_path: - if GitRepository.has_submodules(parent_repo_dir_path): - externals_path = ExternalsDescription.GIT_SUBMODULES_FILENAME - else: - return None - - if not os.path.exists(externals_path): - # NOTE(bja, 2017-10) this check is redundant with the one - # in read_externals_description_file! - msg = ('Externals description file "{0}" ' - 'does not exist! In directory: {1}'.format( - externals_path, parent_repo_dir_path)) - fatal_error(msg) - - externals_root = parent_repo_dir_path - # model_data is a dict-like object which mirrors the file format. - model_data = read_externals_description_file(externals_root, - externals_path) - # ext_description is another dict-like object (see ExternalsDescription) - ext_description = create_externals_description(model_data, - parent_repo=parent_repo) - externals_sourcetree = SourceTree(externals_root, ext_description) - os.chdir(cwd) - return externals_sourcetree - - def __init__(self, root_dir, ext_description, svn_ignore_ancestry=False): - """ - Build a SourceTree object from an ExternalDescription. - - root_dir: the (checked-out) parent repo root dir. - """ - self._root_dir = os.path.abspath(root_dir) - self._all_components = {} # component_name -> _External - self._required_compnames = [] - for comp, desc in ext_description.items(): - local_path = desc[ExternalsDescription.PATH] - required = desc[ExternalsDescription.REQUIRED] - repo_info = desc[ExternalsDescription.REPO] - subexternals_path = desc[ExternalsDescription.EXTERNALS] - - repo = create_repository(comp, - repo_info, - svn_ignore_ancestry=svn_ignore_ancestry) - - sourcetree = None - # Treat a .gitmodules file as a backup externals config - if not subexternals_path: - parent_repo_dir_path = os.path.abspath(os.path.join(root_dir, - local_path)) - if GitRepository.has_submodules(parent_repo_dir_path): - subexternals_path = ExternalsDescription.GIT_SUBMODULES_FILENAME - - # Might return None (if the subexternal isn't checked out yet, or subexternal is None or 'none') - subexternal_sourcetree = SourceTree.from_externals_file( - os.path.join(self._root_dir, local_path), - repo, - subexternals_path) - src = _External(self._root_dir, comp, local_path, required, - subexternals_path, repo, svn_ignore_ancestry, - subexternal_sourcetree) - - self._all_components[comp] = src - if required: - self._required_compnames.append(comp) - - def status(self, relative_path_base=LOCAL_PATH_INDICATOR, - force=False, print_progress=False): - """Return a dictionary of local path->ExternalStatus. - - Notes about the returned dictionary: - * It is keyed by local path (e.g. 'components/mom'), not by - component name (e.g. 'mom'). - * It contains top-level keys for all traversed components, whether - discovered by recursion or top-level. - * It contains entries for all components regardless of whether they - are locally installed or not, or required or optional. -x """ - load_comps = self._all_components.keys() - - summary = {} # Holds merged statuses from all components. - for comp in load_comps: - if print_progress: - printlog('{0}, '.format(comp), end='') - stat = self._all_components[comp].status(force=force, - print_progress=print_progress) - - # Returned status dictionary is keyed by local path; prepend - # relative_path_base if not already there. - stat_final = {} - for name in stat.keys(): - if stat[name].path.startswith(relative_path_base): - stat_final[name] = stat[name] - else: - modified_path = os.path.join(relative_path_base, - stat[name].path) - stat_final[modified_path] = stat[name] - stat_final[modified_path].path = modified_path - summary.update(stat_final) - - return summary - - def _find_installed_optional_components(self): - """Returns a list of installed optional component names, if any.""" - installed_comps = [] - for comp_name, ext in self._all_components.items(): - if comp_name in self._required_compnames: - continue - # Note that in practice we expect this status to be cached. - path_to_stat = ext.status() - - # If any part of this component exists locally, consider it - # installed and therefore eligible for updating. - if any(s.sync_state != ExternalStatus.EMPTY - for s in path_to_stat.values()): - installed_comps.append(comp_name) - return installed_comps - - def checkout(self, verbosity, load_all, load_comp=None): - """ - Checkout or update indicated components into the configured subdirs. - - If load_all is True, checkout all externals (required + optional), recursively. - If load_all is False and load_comp is set, checkout load_comp (and any required subexternals, plus any optional subexternals that are already checked out, recursively) - If load_all is False and load_comp is None, checkout all required externals, plus any optionals that are already checked out, recursively. - """ - if load_all: - tmp_comps = self._all_components.keys() - elif load_comp is not None: - tmp_comps = [load_comp] - else: - local_optional_compnames = self._find_installed_optional_components() - tmp_comps = self._required_compnames + local_optional_compnames - if local_optional_compnames: - printlog('Found locally installed optional components: ' + - ', '.join(local_optional_compnames)) - bad_compnames = set(local_optional_compnames) - set(self._all_components.keys()) - if bad_compnames: - printlog('Internal error: found locally installed components that are not in the global list of all components: ' + ','.join(bad_compnames)) - - if verbosity >= VERBOSITY_VERBOSE: - printlog('Checking out externals: ') - else: - printlog('Checking out externals: ', end='') - - # Sort by path so that if paths are nested the - # parent repo is checked out first. - load_comps = sorted(tmp_comps, key=lambda comp: self._all_components[comp].get_local_path()) - - # checkout. - for comp_name in load_comps: - if verbosity < VERBOSITY_VERBOSE: - printlog('{0}, '.format(comp_name), end='') - else: - # verbose output handled by the _External object, just - # output a newline - printlog(EMPTY_STR) - c = self._all_components[comp_name] - # Does not recurse. - c.checkout(verbosity) - # Recursively check out subexternals, if any. Returns None - # if there's no subexternals path. - component_subexternal_sourcetree = SourceTree.from_externals_file( - c.get_repo_dir_path(), - c.get_repo(), - c.get_subexternals_path()) - c.replace_subexternal_sourcetree(component_subexternal_sourcetree) - if component_subexternal_sourcetree: - component_subexternal_sourcetree.checkout(verbosity, load_all) - printlog('') diff --git a/manage_externals/test/.coveragerc b/manage_externals/test/.coveragerc deleted file mode 100644 index 8b681888b8..0000000000 --- a/manage_externals/test/.coveragerc +++ /dev/null @@ -1,7 +0,0 @@ -[run] -branch = True -omit = test_unit_*.py - test_sys_*.py - /usr/* - .local/* - */site-packages/* \ No newline at end of file diff --git a/manage_externals/test/.gitignore b/manage_externals/test/.gitignore deleted file mode 100644 index dd5795998f..0000000000 --- a/manage_externals/test/.gitignore +++ /dev/null @@ -1,7 +0,0 @@ -# virtual environments -env_python* - -# python code coverage tool output -.coverage -htmlcov - diff --git a/manage_externals/test/.pylint.rc b/manage_externals/test/.pylint.rc deleted file mode 100644 index 64abd03e42..0000000000 --- a/manage_externals/test/.pylint.rc +++ /dev/null @@ -1,426 +0,0 @@ -[MASTER] - -# A comma-separated list of package or module names from where C extensions may -# be loaded. Extensions are loading into the active Python interpreter and may -# run arbitrary code -extension-pkg-whitelist= - -# Add files or directories to the blacklist. They should be base names, not -# paths. -ignore=.git,.svn,env2 - -# Add files or directories matching the regex patterns to the blacklist. The -# regex matches against base names, not paths. -ignore-patterns= - -# Python code to execute, usually for sys.path manipulation such as -# pygtk.require(). -#init-hook= - -# Use multiple processes to speed up Pylint. -jobs=1 - -# List of plugins (as comma separated values of python modules names) to load, -# usually to register additional checkers. -load-plugins= - -# Pickle collected data for later comparisons. -persistent=yes - -# Specify a configuration file. -#rcfile= - -# Allow loading of arbitrary C extensions. Extensions are imported into the -# active Python interpreter and may run arbitrary code. -unsafe-load-any-extension=no - - -[MESSAGES CONTROL] - -# Only show warnings with the listed confidence levels. Leave empty to show -# all. Valid levels: HIGH, INFERENCE, INFERENCE_FAILURE, UNDEFINED -confidence= - -# Disable the message, report, category or checker with the given id(s). You -# can either give multiple identifiers separated by comma (,) or put this -# option multiple times (only on the command line, not in the configuration -# file where it should appear only once).You can also use "--disable=all" to -# disable everything first and then reenable specific checks. For example, if -# you want to run only the similarities checker, you can use "--disable=all -# --enable=similarities". If you want to run only the classes checker, but have -# no Warning level messages displayed, use"--disable=all --enable=classes -# --disable=W" -disable=bad-continuation,useless-object-inheritance - - -# Enable the message, report, category or checker with the given id(s). You can -# either give multiple identifier separated by comma (,) or put this option -# multiple time (only on the command line, not in the configuration file where -# it should appear only once). See also the "--disable" option for examples. -enable= - - -[REPORTS] - -# Python expression which should return a note less than 10 (10 is the highest -# note). You have access to the variables errors warning, statement which -# respectively contain the number of errors / warnings messages and the total -# number of statements analyzed. This is used by the global evaluation report -# (RP0004). -evaluation=10.0 - ((float(5 * error + warning + refactor + convention) / statement) * 10) - -# Template used to display messages. This is a python new-style format string -# used to format the message information. See doc for all details -msg-template={msg_id}:{line:3d},{column:2d}: {msg} ({symbol}) - -# Set the output format. Available formats are text, parseable, colorized, json -# and msvs (visual studio).You can also give a reporter class, eg -# mypackage.mymodule.MyReporterClass. -output-format=text - -# Tells whether to display a full report or only the messages -#reports=yes - -# Activate the evaluation score. -score=yes - - -[REFACTORING] - -# Maximum number of nested blocks for function / method body -max-nested-blocks=5 - - -[BASIC] - -# Naming hint for argument names -argument-name-hint=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ - -# Regular expression matching correct argument names -argument-rgx=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ - -# Naming hint for attribute names -attr-name-hint=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ - -# Regular expression matching correct attribute names -attr-rgx=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ - -# Bad variable names which should always be refused, separated by a comma -bad-names=foo,bar,baz,toto,tutu,tata - -# Naming hint for class attribute names -class-attribute-name-hint=([A-Za-z_][A-Za-z0-9_]{2,30}|(__.*__))$ - -# Regular expression matching correct class attribute names -class-attribute-rgx=([A-Za-z_][A-Za-z0-9_]{2,30}|(__.*__))$ - -# Naming hint for class names -class-name-hint=[A-Z_][a-zA-Z0-9]+$ - -# Regular expression matching correct class names -class-rgx=[A-Z_][a-zA-Z0-9]+$ - -# Naming hint for constant names -const-name-hint=(([A-Z_][A-Z0-9_]*)|(__.*__))$ - -# Regular expression matching correct constant names -const-rgx=(([A-Z_][A-Z0-9_]*)|(__.*__))$ - -# Minimum line length for functions/classes that require docstrings, shorter -# ones are exempt. -docstring-min-length=-1 - -# Naming hint for function names -function-name-hint=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ - -# Regular expression matching correct function names -function-rgx=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ - -# Good variable names which should always be accepted, separated by a comma -good-names=i,j,k,ex,Run,_ - -# Include a hint for the correct naming format with invalid-name -include-naming-hint=no - -# Naming hint for inline iteration names -inlinevar-name-hint=[A-Za-z_][A-Za-z0-9_]*$ - -# Regular expression matching correct inline iteration names -inlinevar-rgx=[A-Za-z_][A-Za-z0-9_]*$ - -# Naming hint for method names -method-name-hint=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ - -# Regular expression matching correct method names -method-rgx=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ - -# Naming hint for module names -module-name-hint=(([a-z_][a-z0-9_]*)|([A-Z][a-zA-Z0-9]+))$ - -# Regular expression matching correct module names -module-rgx=(([a-z_][a-z0-9_]*)|([A-Z][a-zA-Z0-9]+))$ - -# Colon-delimited sets of names that determine each other's naming style when -# the name regexes allow several styles. -name-group= - -# Regular expression which should only match function or class names that do -# not require a docstring. -no-docstring-rgx=^_ - -# List of decorators that produce properties, such as abc.abstractproperty. Add -# to this list to register other decorators that produce valid properties. -property-classes=abc.abstractproperty - -# Naming hint for variable names -variable-name-hint=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ - -# Regular expression matching correct variable names -variable-rgx=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ - - -[FORMAT] - -# Expected format of line ending, e.g. empty (any line ending), LF or CRLF. -expected-line-ending-format= - -# Regexp for a line that is allowed to be longer than the limit. -ignore-long-lines=^\s*(# )??$ - -# Number of spaces of indent required inside a hanging or continued line. -indent-after-paren=4 - -# String used as indentation unit. This is usually " " (4 spaces) or "\t" (1 -# tab). -indent-string=' ' - -# Maximum number of characters on a single line. -max-line-length=100 - -# Maximum number of lines in a module -max-module-lines=1000 - -# List of optional constructs for which whitespace checking is disabled. `dict- -# separator` is used to allow tabulation in dicts, etc.: {1 : 1,\n222: 2}. -# `trailing-comma` allows a space between comma and closing bracket: (a, ). -# `empty-line` allows space-only lines. -no-space-check=trailing-comma,dict-separator - -# Allow the body of a class to be on the same line as the declaration if body -# contains single statement. -single-line-class-stmt=no - -# Allow the body of an if to be on the same line as the test if there is no -# else. -single-line-if-stmt=no - - -[LOGGING] - -# Logging modules to check that the string format arguments are in logging -# function parameter format -logging-modules=logging - - -[MISCELLANEOUS] - -# List of note tags to take in consideration, separated by a comma. -notes=FIXME,XXX,TODO - - -[SIMILARITIES] - -# Ignore comments when computing similarities. -ignore-comments=yes - -# Ignore docstrings when computing similarities. -ignore-docstrings=yes - -# Ignore imports when computing similarities. -ignore-imports=no - -# Minimum lines number of a similarity. -min-similarity-lines=4 - - -[SPELLING] - -# Spelling dictionary name. Available dictionaries: none. To make it working -# install python-enchant package. -spelling-dict= - -# List of comma separated words that should not be checked. -spelling-ignore-words= - -# A path to a file that contains private dictionary; one word per line. -spelling-private-dict-file= - -# Tells whether to store unknown words to indicated private dictionary in -# --spelling-private-dict-file option instead of raising a message. -spelling-store-unknown-words=no - - -[TYPECHECK] - -# List of decorators that produce context managers, such as -# contextlib.contextmanager. Add to this list to register other decorators that -# produce valid context managers. -contextmanager-decorators=contextlib.contextmanager - -# List of members which are set dynamically and missed by pylint inference -# system, and so shouldn't trigger E1101 when accessed. Python regular -# expressions are accepted. -generated-members= - -# Tells whether missing members accessed in mixin class should be ignored. A -# mixin class is detected if its name ends with "mixin" (case insensitive). -ignore-mixin-members=yes - -# This flag controls whether pylint should warn about no-member and similar -# checks whenever an opaque object is returned when inferring. The inference -# can return multiple potential results while evaluating a Python object, but -# some branches might not be evaluated, which results in partial inference. In -# that case, it might be useful to still emit no-member and other checks for -# the rest of the inferred objects. -ignore-on-opaque-inference=yes - -# List of class names for which member attributes should not be checked (useful -# for classes with dynamically set attributes). This supports the use of -# qualified names. -ignored-classes=optparse.Values,thread._local,_thread._local - -# List of module names for which member attributes should not be checked -# (useful for modules/projects where namespaces are manipulated during runtime -# and thus existing member attributes cannot be deduced by static analysis. It -# supports qualified module names, as well as Unix pattern matching. -ignored-modules= - -# Show a hint with possible names when a member name was not found. The aspect -# of finding the hint is based on edit distance. -missing-member-hint=yes - -# The minimum edit distance a name should have in order to be considered a -# similar match for a missing member name. -missing-member-hint-distance=1 - -# The total number of similar names that should be taken in consideration when -# showing a hint for a missing member. -missing-member-max-choices=1 - - -[VARIABLES] - -# List of additional names supposed to be defined in builtins. Remember that -# you should avoid to define new builtins when possible. -additional-builtins= - -# Tells whether unused global variables should be treated as a violation. -allow-global-unused-variables=yes - -# List of strings which can identify a callback function by name. A callback -# name must start or end with one of those strings. -callbacks=cb_,_cb - -# A regular expression matching the name of dummy variables (i.e. expectedly -# not used). -dummy-variables-rgx=_+$|(_[a-zA-Z0-9_]*[a-zA-Z0-9]+?$)|dummy|^ignored_|^unused_ - -# Argument names that match this expression will be ignored. Default to name -# with leading underscore -ignored-argument-names=_.*|^ignored_|^unused_ - -# Tells whether we should check for unused import in __init__ files. -init-import=no - -# List of qualified module names which can have objects that can redefine -# builtins. -redefining-builtins-modules=six.moves,future.builtins - - -[CLASSES] - -# List of method names used to declare (i.e. assign) instance attributes. -defining-attr-methods=__init__,__new__,setUp - -# List of member names, which should be excluded from the protected access -# warning. -exclude-protected=_asdict,_fields,_replace,_source,_make - -# List of valid names for the first argument in a class method. -valid-classmethod-first-arg=cls - -# List of valid names for the first argument in a metaclass class method. -valid-metaclass-classmethod-first-arg=mcs - - -[DESIGN] - -# Maximum number of arguments for function / method -max-args=5 - -# Maximum number of attributes for a class (see R0902). -max-attributes=7 - -# Maximum number of boolean expressions in a if statement -max-bool-expr=5 - -# Maximum number of branch for function / method body -max-branches=12 - -# Maximum number of locals for function / method body -max-locals=15 - -# Maximum number of parents for a class (see R0901). -max-parents=7 - -# Maximum number of public methods for a class (see R0904). -max-public-methods=20 - -# Maximum number of return / yield for function / method body -max-returns=6 - -# Maximum number of statements in function / method body -max-statements=50 - -# Minimum number of public methods for a class (see R0903). -min-public-methods=2 - - -[IMPORTS] - -# Allow wildcard imports from modules that define __all__. -allow-wildcard-with-all=no - -# Analyse import fallback blocks. This can be used to support both Python 2 and -# 3 compatible code, which means that the block might have code that exists -# only in one or another interpreter, leading to false positives when analysed. -analyse-fallback-blocks=no - -# Deprecated modules which should not be used, separated by a comma -deprecated-modules=regsub,TERMIOS,Bastion,rexec - -# Create a graph of external dependencies in the given file (report RP0402 must -# not be disabled) -ext-import-graph= - -# Create a graph of every (i.e. internal and external) dependencies in the -# given file (report RP0402 must not be disabled) -import-graph= - -# Create a graph of internal dependencies in the given file (report RP0402 must -# not be disabled) -int-import-graph= - -# Force import order to recognize a module as part of the standard -# compatibility libraries. -known-standard-library= - -# Force import order to recognize a module as part of a third party library. -known-third-party=enchant - - -[EXCEPTIONS] - -# Exceptions that will emit a warning when being caught. Defaults to -# "Exception" -overgeneral-exceptions=Exception diff --git a/manage_externals/test/Makefile b/manage_externals/test/Makefile deleted file mode 100644 index 293e360757..0000000000 --- a/manage_externals/test/Makefile +++ /dev/null @@ -1,124 +0,0 @@ -python = not-set -verbose = not-set -debug = not-set - -ifneq ($(python), not-set) -PYTHON=$(python) -else -PYTHON=python -endif - -# we need the python path to point one level up to access the package -# and executables -PYPATH=PYTHONPATH=..: - -# common args for running tests -TEST_ARGS=-m unittest discover - -ifeq ($(debug), not-set) - ifeq ($(verbose), not-set) - # summary only output - TEST_ARGS+=--buffer - else - # show individual test summary - TEST_ARGS+=--buffer --verbose - endif -else - # show detailed test output - TEST_ARGS+=--verbose -endif - - -# auto reformat the code -AUTOPEP8=autopep8 -AUTOPEP8_ARGS=--aggressive --in-place - -# run lint -PYLINT=pylint -PYLINT_ARGS=-j 2 --rcfile=.pylint.rc - -# code coverage -COVERAGE=coverage -COVERAGE_ARGS=--rcfile=.coveragerc - -# source files -SRC = \ - ../checkout_externals \ - ../manic/*.py - -CHECKOUT_EXE = ../checkout_externals - -TEST_DIR = . - -README = ../README.md - -# -# testing -# -.PHONY : utest -utest : FORCE - $(PYPATH) $(PYTHON) $(TEST_ARGS) --pattern 'test_unit_*.py' - -.PHONY : stest -stest : FORCE - $(PYPATH) $(PYTHON) $(TEST_ARGS) --pattern 'test_sys_*.py' - -.PHONY : test -test : utest stest - -# -# documentation -# -.PHONY : readme -readme : $(CHECKOUT_EXE) - printf "%s\n\n" "-- AUTOMATICALLY GENERATED FILE. DO NOT EDIT --" > $(README) - printf "%s" '[![Build Status](https://travis-ci.org/ESMCI/manage_externals.svg?branch=master)](https://travis-ci.org/ESMCI/manage_externals)' >> $(README) - printf "%s" '[![Coverage Status](https://coveralls.io/repos/github/ESMCI/manage_externals/badge.svg?branch=master)](https://coveralls.io/github/ESMCI/manage_externals?branch=master)' >> $(README) - printf "\n%s\n" '```' >> $(README) - $(CHECKOUT_EXE) --help >> $(README) - -# -# coding standards -# -.PHONY : style -style : FORCE - $(AUTOPEP8) $(AUTOPEP8_ARGS) --recursive $(SRC) $(TEST_DIR)/test_*.py - -.PHONY : lint -lint : FORCE - $(PYLINT) $(PYLINT_ARGS) $(SRC) $(TEST_DIR)/test_*.py - -.PHONY : stylint -stylint : style lint - -.PHONY : coverage -# Need to use a single coverage run with a single pattern rather than -# using two separate commands with separate patterns for test_unit_*.py -# and test_sys_*.py: The latter clobbers some results from the first -# run, even if we use the --append flag to 'coverage run'. -coverage : FORCE - $(PYPATH) $(COVERAGE) erase - $(PYPATH) $(COVERAGE) run $(COVERAGE_ARGS) $(TEST_ARGS) --pattern 'test_*.py' - $(PYPATH) $(COVERAGE) html - -# -# virtual environment creation -# -.PHONY : env -env : FORCE - $(PYPATH) virtualenv --python $(PYTHON) $@_$(PYTHON) - . $@_$(PYTHON)/bin/activate; pip install -r requirements.txt - -# -# utilites -# -.PHONY : clean -clean : FORCE - -rm -rf *~ *.pyc tmp fake htmlcov - -.PHONY : clobber -clobber : clean - -rm -rf env_* - -FORCE : - diff --git a/manage_externals/test/README.md b/manage_externals/test/README.md deleted file mode 100644 index 1e8f2eaa77..0000000000 --- a/manage_externals/test/README.md +++ /dev/null @@ -1,53 +0,0 @@ -# Testing for checkout_externals - -## Unit tests - -```SH - cd checkout_externals/test - make utest -``` - -## System tests - -```SH - cd checkout_externals/test - make stest -``` - -Example to run a single test: -```SH - cd checkout_externals - python -m unittest test.test_sys_checkout.TestSysCheckout.test_container_simple_required -``` - -## Static analysis - -checkout_externals is difficult to test thoroughly because it relies -on git and svn, and svn requires a live network connection and -repository. Static analysis will help catch bugs in code paths that -are not being executed, but it requires conforming to community -standards and best practices. autopep8 and pylint should be run -regularly for automatic code formatting and linting. - -```SH - cd checkout_externals/test - make lint -``` - -The canonical formatting for the code is whatever autopep8 -generates. All issues identified by pylint should be addressed. - - -## Code coverage - -All changes to the code should include maintaining existing tests and -writing new tests for new or changed functionality. To ensure test -coverage, run the code coverage tool: - -```SH - cd checkout_externals/test - make coverage - open -a Firefox.app htmlcov/index.html -``` - - diff --git a/manage_externals/test/doc/.gitignore b/manage_externals/test/doc/.gitignore deleted file mode 100644 index d4e11e5ea0..0000000000 --- a/manage_externals/test/doc/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -_build - diff --git a/manage_externals/test/doc/conf.py b/manage_externals/test/doc/conf.py deleted file mode 100644 index 469c0b0dc5..0000000000 --- a/manage_externals/test/doc/conf.py +++ /dev/null @@ -1,172 +0,0 @@ -# -*- coding: utf-8 -*- -# -# Manage Externals documentation build configuration file, created by -# sphinx-quickstart on Wed Nov 29 10:53:25 2017. -# -# This file is execfile()d with the current directory set to its -# containing dir. -# -# Note that not all possible configuration values are present in this -# autogenerated file. -# -# All configuration values have a default; values that are commented out -# serve to show the default. - -# If extensions (or modules to document with autodoc) are in another directory, -# add these directories to sys.path here. If the directory is relative to the -# documentation root, use os.path.abspath to make it absolute, like shown here. -# -# import os -# import sys -# sys.path.insert(0, os.path.abspath('.')) - - -# -- General configuration ------------------------------------------------ - -# If your documentation needs a minimal Sphinx version, state it here. -# -# needs_sphinx = '1.0' - -# Add any Sphinx extension module names here, as strings. They can be -# extensions coming with Sphinx (named 'sphinx.ext.*') or your custom -# ones. -extensions = ['sphinx.ext.autodoc', - 'sphinx.ext.todo', - 'sphinx.ext.coverage', - 'sphinx.ext.viewcode', - 'sphinx.ext.githubpages'] - -# Add any paths that contain templates here, relative to this directory. -templates_path = ['_templates'] - -# The suffix(es) of source filenames. -# You can specify multiple suffix as a list of string: -# -# source_suffix = ['.rst', '.md'] -source_suffix = '.rst' - -# The master toctree document. -master_doc = 'index' - -# General information about the project. -project = u'Manage Externals' -copyright = u'2017, CSEG at NCAR' -author = u'CSEG at NCAR' - -# The version info for the project you're documenting, acts as replacement for -# |version| and |release|, also used in various other places throughout the -# built documents. -# -# The short X.Y version. -version = u'1.0.0' -# The full version, including alpha/beta/rc tags. -release = u'1.0.0' - -# The language for content autogenerated by Sphinx. Refer to documentation -# for a list of supported languages. -# -# This is also used if you do content translation via gettext catalogs. -# Usually you set "language" from the command line for these cases. -language = None - -# List of patterns, relative to source directory, that match files and -# directories to ignore when looking for source files. -# This patterns also effect to html_static_path and html_extra_path -exclude_patterns = ['_build', 'Thumbs.db', '.DS_Store'] - -# The name of the Pygments (syntax highlighting) style to use. -pygments_style = 'sphinx' - -# If true, `todo` and `todoList` produce output, else they produce nothing. -todo_include_todos = True - - -# -- Options for HTML output ---------------------------------------------- - -# The theme to use for HTML and HTML Help pages. See the documentation for -# a list of builtin themes. -# -html_theme = 'alabaster' - -# Theme options are theme-specific and customize the look and feel of a theme -# further. For a list of options available for each theme, see the -# documentation. -# -# html_theme_options = {} - -# Add any paths that contain custom static files (such as style sheets) here, -# relative to this directory. They are copied after the builtin static files, -# so a file named "default.css" will overwrite the builtin "default.css". -html_static_path = ['_static'] - -# Custom sidebar templates, must be a dictionary that maps document names -# to template names. -# -# This is required for the alabaster theme -# refs: http://alabaster.readthedocs.io/en/latest/installation.html#sidebars -html_sidebars = { - '**': [ - 'relations.html', # needs 'show_related': True theme option to display - 'searchbox.html', - ] -} - - -# -- Options for HTMLHelp output ------------------------------------------ - -# Output file base name for HTML help builder. -htmlhelp_basename = 'ManageExternalsdoc' - - -# -- Options for LaTeX output --------------------------------------------- - -latex_elements = { - # The paper size ('letterpaper' or 'a4paper'). - # - # 'papersize': 'letterpaper', - - # The font size ('10pt', '11pt' or '12pt'). - # - # 'pointsize': '10pt', - - # Additional stuff for the LaTeX preamble. - # - # 'preamble': '', - - # Latex figure (float) alignment - # - # 'figure_align': 'htbp', -} - -# Grouping the document tree into LaTeX files. List of tuples -# (source start file, target name, title, -# author, documentclass [howto, manual, or own class]). -latex_documents = [ - (master_doc, 'ManageExternals.tex', u'Manage Externals Documentation', - u'CSEG at NCAR', 'manual'), -] - - -# -- Options for manual page output --------------------------------------- - -# One entry per manual page. List of tuples -# (source start file, name, description, authors, manual section). -man_pages = [ - (master_doc, 'manageexternals', u'Manage Externals Documentation', - [author], 1) -] - - -# -- Options for Texinfo output ------------------------------------------- - -# Grouping the document tree into Texinfo files. List of tuples -# (source start file, target name, title, author, -# dir menu entry, description, category) -texinfo_documents = [ - (master_doc, 'ManageExternals', u'Manage Externals Documentation', - author, 'ManageExternals', 'One line description of project.', - 'Miscellaneous'), -] - - - diff --git a/manage_externals/test/doc/develop.rst b/manage_externals/test/doc/develop.rst deleted file mode 100644 index b817b7b093..0000000000 --- a/manage_externals/test/doc/develop.rst +++ /dev/null @@ -1,202 +0,0 @@ -Developer Guidelines -==================== - -The manage externals utilities are a light weight replacement for svn -externals that will work with git repositories pulling in a mixture of -git and svn dependencies. - -Given an externals description and a working copy: - -* *checkout_externals* attempts to make the working copy agree with the - externals description - -* *generate_externals* attempts to make the externals description agree - with the working copy. - -For these operations utilities should: - -* operate consistently across git and svn - -* operate simply with minimal user complexity - -* robustly across a wide range of repository states - -* provide explicit error messages when a problem occurs - -* leave the working copy in a valid state - -The utilities in manage externals are **NOT** generic wrappers around -revision control operations or a replacement for common tasks. Users -are expected to: - -* create branches prior to starting development - -* add remotes and push changes - -* create tags - -* delete branches - -These types of tasks are often highly workflow dependent, e.g. branch -naming conventions may vary between repositories, have the potential -to destroy user data, introduce significant code complexit and 'edge -cases' that are extremely difficult to detect and test, and often -require subtle decision making, especially if a problem occurs. - -Users who want to automate these types are encouraged to create their -own tools. The externals description files are explicitly versioned -and the internal APIs are intended to be stable for these purposes. - -Core Design Principles ------------------------ - -1. Users can, and are actively encouraged to, modify the externals - directories using revision control outside of manage_externals - tools. You can't make any assumptions about the state of the - working copy. Examples: adding a remote, creating a branch, - switching to a branch, deleting the directory entirely. - -2. Give that the user can do anything, the manage externals library - can not preserve state between calls. The only information it can - rely on is what it expectes based on the content of the externals - description file, and what the actual state of the directory tree - is. - -3. Do *not* do anything that will possibly destroy user data! - - a. Do not remove files from the file system. We are operating on - user supplied input. If you don't call 'rm', you can't - accidentally remove the user's data. Thinking of calling - ``shutil.rmtree(user_input)``? What if the user accidentally - specified user_input such that it resolves to their home - directory.... Yeah. Don't go there. - - b. Rely on git and svn to do their job as much as possible. Don't - duplicate functionality. Examples: - - i. We require the working copies to be 'clean' as reported by - ``git status`` and ``svn status``. What if there are misc - editor files floating around that prevent an update? Use the - git and svn ignore functionality so they are not - reported. Don't try to remove them from manage_externals or - determine if they are 'safe' to ignore. - - ii. Do not use '--force'. Ever. This is a sign you are doing - something dangerous, it may not be what the user - wants. Remember, they are encouraged to modify their repo. - -4. There are often multiple ways to obtain a particular piece of - information from git. Scraping screen output is brittle and - generally not considered a stable API across different versions of - git. Given a choice between: - - a. a lower level git 'plumbing' command that processes a - specific request and returns a sucess/failure status. - - b. high level git command that produces a bunch of output - that must be processed. - - We always prefer the former. It almost always involves - writing and maintaining less code and is more likely to be - stable. - -5. Backward compatibility is critical. We have *nested* - repositories. They are trivially easy to change versions. They may - have very different versions of the top level manage_externals. The - ability to read and work with old model description files is - critical to avoid problems for users. We also have automated tools - (testdb) that must generate and read external description - files. Backward compatibility will make staging changes vastly - simpler. - -Model Users ------------ - -Consider the needs of the following model userswhen developing manage_externals: - -* Users who will checkout the code once, and never change versions. - -* Users who will checkout the code once, then work for several years, - never updating. before trying to update or request integration. - -* Users develope code but do not use revision control beyond the - initial checkout. If they have modified or untracked files in the - repo, they may be irreplacable. Don't destroy user data. - -* Intermediate users who are working with multiple repos or branches - on a regular basis. They may only use manage_externals weekly or - monthly. Keep the user interface and documentation simple and - explicit. The more command line options they have to remember or - look up, the more frustrated they git. - -* Software engineers who use the tools multiple times a day. It should - get out of their way. - -User Interface --------------- - -Basic operation for the most standard use cases should be kept as -simple as possible. Many users will only rarely run the manage -utilities. Even advanced users don't like reading a lot of help -documentation or struggling to remember commands and piece together -what they need to run. Having many command line options, even if not -needed, is exteremly frustrating and overwhelming for most users. A few -simple, explicitly named commands are better than a single command -with many options. - -How will users get help if something goes wrong? This is a custom, -one-off solution. Searching the internet for manage_externals, will -only return the user doc for this project at best. There isn't likely -to be a stackoverflow question or blog post where someone else already -answered a user's question. And very few people outside this community -will be able to provide help if something goes wrong. The sooner we -kick users out of these utilities and into standard version control -tools, the better off they are going to be if they run into a problem. - -Repositories ------------- - -There are three basic types of repositories that must be considered: - -* container repositories - repositories that are always top level - repositories, and have a group of externals that must be managed. - -* simple repositories - repositories that are externals to another - repository, and do not have any of their own externals that will be - managed. - -* mixed use repositories - repositories that can act as a top level - container repository or as an external to a top level - container. They may also have their own sub-externals that are - required. They may have different externals needs depening on - whether they are top level or not. - -Repositories must be able to checkout and switch to both branches and -tags. - -Development -=========== - -The functionality to manage externals is broken into a library of core -functionality and applications built with the library. - -The core library is called 'manic', pseduo-homophone of (man)age -(ex)ternals that is: short, pronounceable and spell-checkable. It is -also no more or less meaningful to an unfamiliar user than a random -jumble of letters forming an acronym. - -The core architecture of manic is: - -* externals description - an abstract description on an external, - including of how to obtain it, where to obtain it, where it goes in - the working tree. - -* externals - the software object representing an external. - -* source trees - collection of externals - -* repository wrappers - object oriented wrappers around repository - operations. So the higher level management of the soure tree and - external does not have to be concerned with how a particular - external is obtained and managed. - diff --git a/manage_externals/test/doc/index.rst b/manage_externals/test/doc/index.rst deleted file mode 100644 index 9ab287ad8c..0000000000 --- a/manage_externals/test/doc/index.rst +++ /dev/null @@ -1,22 +0,0 @@ -.. Manage Externals documentation master file, created by - sphinx-quickstart on Wed Nov 29 10:53:25 2017. - You can adapt this file completely to your liking, but it should at least - contain the root `toctree` directive. - -Welcome to Manage Externals's documentation! -============================================ - -.. toctree:: - :maxdepth: 2 - :caption: Contents: - - - develop.rst - testing.rst - -Indices and tables -================== - -* :ref:`genindex` -* :ref:`modindex` -* :ref:`search` diff --git a/manage_externals/test/doc/testing.rst b/manage_externals/test/doc/testing.rst deleted file mode 100644 index 623f0e431c..0000000000 --- a/manage_externals/test/doc/testing.rst +++ /dev/null @@ -1,123 +0,0 @@ -Testing -======= - -The manage_externals package has an automated test suite. All pull -requests are expected to pass 100% of the automated tests, as well as -be pep8 and lint 'clean' and maintain approximately constant (at a -minimum) level of code coverage. - -Quick Start ------------ - -Do nothing approach -~~~~~~~~~~~~~~~~~~~ - -When you create a pull request on GitHub, Travis-CI continuous -integration testing will run the test suite in both python2 and -python3. Test results, lint results, and code coverage results are -available online. - -Do something approach -~~~~~~~~~~~~~~~~~~~~~ - -In the test directory, run: - -.. code-block:: shell - - make env - make lint - make test - make coverage - - -Automated Testing ------------------ - -The manage_externals manic library and executables are developed to be -python2 and python3 compatible using only the standard library. The -test suites meet the same requirements. But additional tools are -required to provide lint and code coverage metrics and generate -documentation. The requirements are maintained in the requirements.txt -file, and can be automatically installed into an isolated environment -via Makefile. - -Bootstrap requirements: - -* python2 - version 2.7.x or later - -* python3 - version 3.6 tested other versions may work - -* pip and virtualenv for python2 and python3 - -Note: all make rules can be of the form ``make python=pythonX rule`` -or ``make rule`` depending if you want to use the default system -python or specify a specific version. - -The Makefile in the test directory has the following rules: - -* ``make python=pythonX env`` - create a python virtual environment - for python2 or python3 and install all required packages. These - packages are required to run lint or coverage. - -* ``make style`` - runs autopep8 - -* ``make lint`` - runs autopep8 and pylint - -* ``make test`` - run the full test suite - -* ``make utest`` - run jus the unit tests - -* ``make stest`` - run jus the system integration tests - -* ``make coverage`` - run the full test suite through the code - coverage tool and generate an html report. - -* ``make readme`` - automatically generate the README files. - -* ``make clean`` - remove editor and pyc files - -* ``make clobber`` - remove all generated test files, including - virtual environments, coverage reports, and temporary test - repository directories. - -Unit Tests ----------- - -Unit tests are probably not 'true unit tests' for the pedantic, but -are pragmatic unit tests. They cover small practicle code blocks: -functions, class methods, and groups of functions and class methods. - -System Integration Tests ------------------------- - -NOTE(bja, 2017-11) The systems integration tests currently do not include svn repositories. - -The manage_externals package is extremely tedious and error prone to test manually. - -Combinations that must be tested to ensure basic functionality are: - -* container repository pulling in simple externals - -* container repository pulling in mixed externals with sub-externals. - -* mixed repository acting as a container, pulling in simple externals and sub-externals - -Automatic system tests are handled the same way manual testing is done: - -* clone a test repository - -* create an externals description file for the test - -* run the executable with the desired args - -* check the results - -* potentially modify the repo (checkout a different branch) - -* rerun and test - -* etc - -The automated system stores small test repositories in the main repo -by adding them as bare repositories. These repos are cloned via a -subprocess call to git and manipulated during the tests. diff --git a/manage_externals/test/repos/README.md b/manage_externals/test/repos/README.md deleted file mode 100644 index 8a3502c35f..0000000000 --- a/manage_externals/test/repos/README.md +++ /dev/null @@ -1,33 +0,0 @@ -Git repositories for testing git-related behavior. For usage and terminology notes, see test/test_sys_checkout.py. - -To list files and view file contents at HEAD: -``` -cd -git ls-tree --full-tree -r --name-only HEAD -git cat-file -p HEAD: -``` - -File contents at a glance: -``` -container.git/ - readme.txt - -simple-ext.git/ - (has branches: feature2, feature3) - (has tags: tag1, tag2) - readme.txt - simple_subdir/subdir_file.txt - -simple-ext-fork.git/ - (has tags: abandoned-feature, forked-feature-v1, tag1) - (has branch: feature2) - readme.txt - -mixed-cont-ext.git/ - (has branch: new-feature) - readme.txt - sub-externals.cfg ('simp_branch' section refers to 'feature2' branch in simple-ext.git/ repo) - -error/ - (no git repo here, just a readme.txt in the clear) -``` diff --git a/manage_externals/test/repos/container.git/HEAD b/manage_externals/test/repos/container.git/HEAD deleted file mode 100644 index cb089cd89a..0000000000 --- a/manage_externals/test/repos/container.git/HEAD +++ /dev/null @@ -1 +0,0 @@ -ref: refs/heads/master diff --git a/manage_externals/test/repos/container.git/config b/manage_externals/test/repos/container.git/config deleted file mode 100644 index e6da231579..0000000000 --- a/manage_externals/test/repos/container.git/config +++ /dev/null @@ -1,6 +0,0 @@ -[core] - repositoryformatversion = 0 - filemode = true - bare = true - ignorecase = true - precomposeunicode = true diff --git a/manage_externals/test/repos/container.git/description b/manage_externals/test/repos/container.git/description deleted file mode 100644 index 498b267a8c..0000000000 --- a/manage_externals/test/repos/container.git/description +++ /dev/null @@ -1 +0,0 @@ -Unnamed repository; edit this file 'description' to name the repository. diff --git a/manage_externals/test/repos/container.git/info/exclude b/manage_externals/test/repos/container.git/info/exclude deleted file mode 100644 index a5196d1be8..0000000000 --- a/manage_externals/test/repos/container.git/info/exclude +++ /dev/null @@ -1,6 +0,0 @@ -# git ls-files --others --exclude-from=.git/info/exclude -# Lines that start with '#' are comments. -# For a project mostly in C, the following would be a good set of -# exclude patterns (uncomment them if you want to use them): -# *.[oa] -# *~ diff --git a/manage_externals/test/repos/container.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 b/manage_externals/test/repos/container.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 deleted file mode 100644 index f65234e17f..0000000000 Binary files a/manage_externals/test/repos/container.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 and /dev/null differ diff --git a/manage_externals/test/repos/container.git/objects/71/5b8f3e4afe1802a178e1d603af404ba45d59de b/manage_externals/test/repos/container.git/objects/71/5b8f3e4afe1802a178e1d603af404ba45d59de deleted file mode 100644 index 9759965b1b..0000000000 Binary files a/manage_externals/test/repos/container.git/objects/71/5b8f3e4afe1802a178e1d603af404ba45d59de and /dev/null differ diff --git a/manage_externals/test/repos/container.git/objects/b0/f87705e2b9601cb831878f3d51efa78b910d7b b/manage_externals/test/repos/container.git/objects/b0/f87705e2b9601cb831878f3d51efa78b910d7b deleted file mode 100644 index d9976cc442..0000000000 Binary files a/manage_externals/test/repos/container.git/objects/b0/f87705e2b9601cb831878f3d51efa78b910d7b and /dev/null differ diff --git a/manage_externals/test/repos/container.git/objects/f9/e08370a737e941de6f6492e3f427c2ef4c1a03 b/manage_externals/test/repos/container.git/objects/f9/e08370a737e941de6f6492e3f427c2ef4c1a03 deleted file mode 100644 index 460fd77819..0000000000 Binary files a/manage_externals/test/repos/container.git/objects/f9/e08370a737e941de6f6492e3f427c2ef4c1a03 and /dev/null differ diff --git a/manage_externals/test/repos/container.git/refs/heads/master b/manage_externals/test/repos/container.git/refs/heads/master deleted file mode 100644 index 3ae00f3af0..0000000000 --- a/manage_externals/test/repos/container.git/refs/heads/master +++ /dev/null @@ -1 +0,0 @@ -715b8f3e4afe1802a178e1d603af404ba45d59de diff --git a/manage_externals/test/repos/error/readme.txt b/manage_externals/test/repos/error/readme.txt deleted file mode 100644 index 6b5753377e..0000000000 --- a/manage_externals/test/repos/error/readme.txt +++ /dev/null @@ -1,3 +0,0 @@ -Invalid or corrupted git repository (.git dir exists, but is empty) for error -testing. - diff --git a/manage_externals/test/repos/mixed-cont-ext.git/HEAD b/manage_externals/test/repos/mixed-cont-ext.git/HEAD deleted file mode 100644 index cb089cd89a..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/HEAD +++ /dev/null @@ -1 +0,0 @@ -ref: refs/heads/master diff --git a/manage_externals/test/repos/mixed-cont-ext.git/config b/manage_externals/test/repos/mixed-cont-ext.git/config deleted file mode 100644 index e6da231579..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/config +++ /dev/null @@ -1,6 +0,0 @@ -[core] - repositoryformatversion = 0 - filemode = true - bare = true - ignorecase = true - precomposeunicode = true diff --git a/manage_externals/test/repos/mixed-cont-ext.git/description b/manage_externals/test/repos/mixed-cont-ext.git/description deleted file mode 100644 index 498b267a8c..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/description +++ /dev/null @@ -1 +0,0 @@ -Unnamed repository; edit this file 'description' to name the repository. diff --git a/manage_externals/test/repos/mixed-cont-ext.git/info/exclude b/manage_externals/test/repos/mixed-cont-ext.git/info/exclude deleted file mode 100644 index a5196d1be8..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/info/exclude +++ /dev/null @@ -1,6 +0,0 @@ -# git ls-files --others --exclude-from=.git/info/exclude -# Lines that start with '#' are comments. -# For a project mostly in C, the following would be a good set of -# exclude patterns (uncomment them if you want to use them): -# *.[oa] -# *~ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/00/437ac2000d5f06fb8a572a01a5bbdae98b17cb b/manage_externals/test/repos/mixed-cont-ext.git/objects/00/437ac2000d5f06fb8a572a01a5bbdae98b17cb deleted file mode 100644 index 145a6990a8..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/00/437ac2000d5f06fb8a572a01a5bbdae98b17cb and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/01/97458f2dbe5fcd6bc44fa46983be0a30282379 b/manage_externals/test/repos/mixed-cont-ext.git/objects/01/97458f2dbe5fcd6bc44fa46983be0a30282379 deleted file mode 100644 index 032f4b1ca6..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/01/97458f2dbe5fcd6bc44fa46983be0a30282379 and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/06/ea30b03ffa2f8574705f8b9583f7ca7e2dccf7 b/manage_externals/test/repos/mixed-cont-ext.git/objects/06/ea30b03ffa2f8574705f8b9583f7ca7e2dccf7 deleted file mode 100644 index 13d15a96a5..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/06/ea30b03ffa2f8574705f8b9583f7ca7e2dccf7 and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/14/368b701616a8c53820b610414a4b9a07540cf6 b/manage_externals/test/repos/mixed-cont-ext.git/objects/14/368b701616a8c53820b610414a4b9a07540cf6 deleted file mode 100644 index 53c4e79ed0..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/objects/14/368b701616a8c53820b610414a4b9a07540cf6 +++ /dev/null @@ -1 +0,0 @@ -x50S0A1FMWiRh-iitjz h#F+|m"rFd <;s̱۬OEQE}TLU<,9}]IiP. 9ze vA$8#DK \ No newline at end of file diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/15/2b57e1cf23721cd17ff681cb9276e3fb9fc091 b/manage_externals/test/repos/mixed-cont-ext.git/objects/15/2b57e1cf23721cd17ff681cb9276e3fb9fc091 deleted file mode 100644 index d09c006f07..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/objects/15/2b57e1cf23721cd17ff681cb9276e3fb9fc091 +++ /dev/null @@ -1,2 +0,0 @@ -xKn0 )xEӛP"eCuzb0Su)!h9.!<ے,s$P0/f.M_ɅKjc٧$03Ytz:|HK.p缏BUxzL`N2M2J]K۾># -MPtM0v&>Kci8V; \ No newline at end of file diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/1f/01fa46c17b1f38b37e6259f6e9d041bda3144f b/manage_externals/test/repos/mixed-cont-ext.git/objects/1f/01fa46c17b1f38b37e6259f6e9d041bda3144f deleted file mode 100644 index 7bacde68db..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/1f/01fa46c17b1f38b37e6259f6e9d041bda3144f and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/37/f0e70b609adc90f4c09ee21d82ed1d79c81d69 b/manage_externals/test/repos/mixed-cont-ext.git/objects/37/f0e70b609adc90f4c09ee21d82ed1d79c81d69 deleted file mode 100644 index 8c6b04837a..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/37/f0e70b609adc90f4c09ee21d82ed1d79c81d69 and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/38/9a2b876b8965d3c91a3db8d28a483eaf019d5c b/manage_externals/test/repos/mixed-cont-ext.git/objects/38/9a2b876b8965d3c91a3db8d28a483eaf019d5c deleted file mode 100644 index 1a35b74d47..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/38/9a2b876b8965d3c91a3db8d28a483eaf019d5c and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 b/manage_externals/test/repos/mixed-cont-ext.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 deleted file mode 100644 index f65234e17f..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/6e/9f4baa6e94a0af4e094836c2eb55ccedef5fc4 b/manage_externals/test/repos/mixed-cont-ext.git/objects/6e/9f4baa6e94a0af4e094836c2eb55ccedef5fc4 deleted file mode 100644 index 6b2146cae4..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/6e/9f4baa6e94a0af4e094836c2eb55ccedef5fc4 and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/6f/c379457ecb4e576a13c7610ae1fa73f845ee6a b/manage_externals/test/repos/mixed-cont-ext.git/objects/6f/c379457ecb4e576a13c7610ae1fa73f845ee6a deleted file mode 100644 index 852a051139..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/objects/6f/c379457ecb4e576a13c7610ae1fa73f845ee6a +++ /dev/null @@ -1 +0,0 @@ -xAN09sʎ;~2J^M,'8ԝھ_yyR3؍lmvƕPBFC>y*bla-n^]D,xfv2p׭ }GzxNvq~Zc y+QTt;]C:AgA( XAG*=i\_^' \ No newline at end of file diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/93/a159deb9175bfeb2820a0006ddd92d78131332 b/manage_externals/test/repos/mixed-cont-ext.git/objects/93/a159deb9175bfeb2820a0006ddd92d78131332 deleted file mode 100644 index 682d799898..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/93/a159deb9175bfeb2820a0006ddd92d78131332 and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/95/80ecc12f16334ce44e42287d5d46f927bb7b75 b/manage_externals/test/repos/mixed-cont-ext.git/objects/95/80ecc12f16334ce44e42287d5d46f927bb7b75 deleted file mode 100644 index 33c9f6cdf1..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/objects/95/80ecc12f16334ce44e42287d5d46f927bb7b75 +++ /dev/null @@ -1 +0,0 @@ -xKN0YcȟLlK7鴟5#{OzғmW%ӓv8&eFٱ$/UɞzRJ%ZY |YSC/'*}A7Cۑϋ1^L0f7c b/Jo5-Ů;҅AH:XADZ:ڇ8M^ \ No newline at end of file diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/a9/288dcd8a719a1f4ed3cba43a2a387ae7cd60fd b/manage_externals/test/repos/mixed-cont-ext.git/objects/a9/288dcd8a719a1f4ed3cba43a2a387ae7cd60fd deleted file mode 100644 index 73e7cbfbc8..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/a9/288dcd8a719a1f4ed3cba43a2a387ae7cd60fd and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/e8/ea32a11d30ee703f6f661ae7c2376f4ab84d38 b/manage_externals/test/repos/mixed-cont-ext.git/objects/e8/ea32a11d30ee703f6f661ae7c2376f4ab84d38 deleted file mode 100644 index 189ed85bb3..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/e8/ea32a11d30ee703f6f661ae7c2376f4ab84d38 and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/fd/15a5ad5204356229c60a831d2a8120a43ac901 b/manage_externals/test/repos/mixed-cont-ext.git/objects/fd/15a5ad5204356229c60a831d2a8120a43ac901 deleted file mode 100644 index 619e38ee78..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/objects/fd/15a5ad5204356229c60a831d2a8120a43ac901 +++ /dev/null @@ -1,2 +0,0 @@ -x=;0 :v =rJf`) noW)zgA >.pA -! w4ݵQ=äZ90k G)* \ No newline at end of file diff --git a/manage_externals/test/repos/mixed-cont-ext.git/refs/heads/master b/manage_externals/test/repos/mixed-cont-ext.git/refs/heads/master deleted file mode 100644 index 1e0eef1ea3..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/refs/heads/master +++ /dev/null @@ -1 +0,0 @@ -6fc379457ecb4e576a13c7610ae1fa73f845ee6a diff --git a/manage_externals/test/repos/mixed-cont-ext.git/refs/heads/new-feature b/manage_externals/test/repos/mixed-cont-ext.git/refs/heads/new-feature deleted file mode 100644 index 607e80d1bc..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/refs/heads/new-feature +++ /dev/null @@ -1 +0,0 @@ -9580ecc12f16334ce44e42287d5d46f927bb7b75 diff --git a/manage_externals/test/repos/simple-ext-fork.git/HEAD b/manage_externals/test/repos/simple-ext-fork.git/HEAD deleted file mode 100644 index cb089cd89a..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/HEAD +++ /dev/null @@ -1 +0,0 @@ -ref: refs/heads/master diff --git a/manage_externals/test/repos/simple-ext-fork.git/config b/manage_externals/test/repos/simple-ext-fork.git/config deleted file mode 100644 index 04eba17870..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/config +++ /dev/null @@ -1,8 +0,0 @@ -[core] - repositoryformatversion = 0 - filemode = true - bare = true - ignorecase = true - precomposeunicode = true -[remote "origin"] - url = /Users/andreb/projects/ncar/git-conversion/checkout-model-dev/cesm-demo-externals/manage_externals/test/repos/simple-ext.git diff --git a/manage_externals/test/repos/simple-ext-fork.git/description b/manage_externals/test/repos/simple-ext-fork.git/description deleted file mode 100644 index 498b267a8c..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/description +++ /dev/null @@ -1 +0,0 @@ -Unnamed repository; edit this file 'description' to name the repository. diff --git a/manage_externals/test/repos/simple-ext-fork.git/info/exclude b/manage_externals/test/repos/simple-ext-fork.git/info/exclude deleted file mode 100644 index a5196d1be8..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/info/exclude +++ /dev/null @@ -1,6 +0,0 @@ -# git ls-files --others --exclude-from=.git/info/exclude -# Lines that start with '#' are comments. -# For a project mostly in C, the following would be a good set of -# exclude patterns (uncomment them if you want to use them): -# *.[oa] -# *~ diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/00/fd13e76189f9134b0506b4b8ed3172723b467f b/manage_externals/test/repos/simple-ext-fork.git/objects/00/fd13e76189f9134b0506b4b8ed3172723b467f deleted file mode 100644 index ae28c037e5..0000000000 Binary files a/manage_externals/test/repos/simple-ext-fork.git/objects/00/fd13e76189f9134b0506b4b8ed3172723b467f and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/0b/15e8af3d4615b42314216efeae3fff184046a8 b/manage_externals/test/repos/simple-ext-fork.git/objects/0b/15e8af3d4615b42314216efeae3fff184046a8 deleted file mode 100644 index 32d6896e3c..0000000000 Binary files a/manage_externals/test/repos/simple-ext-fork.git/objects/0b/15e8af3d4615b42314216efeae3fff184046a8 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/0b/67df4e7e8e6e1c6e401542738b352d18744677 b/manage_externals/test/repos/simple-ext-fork.git/objects/0b/67df4e7e8e6e1c6e401542738b352d18744677 deleted file mode 100644 index db51ce1953..0000000000 Binary files a/manage_externals/test/repos/simple-ext-fork.git/objects/0b/67df4e7e8e6e1c6e401542738b352d18744677 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/11/a76e3d9a67313dec7ce1230852ab5c86352c5c b/manage_externals/test/repos/simple-ext-fork.git/objects/11/a76e3d9a67313dec7ce1230852ab5c86352c5c deleted file mode 100644 index 564e7bba63..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/objects/11/a76e3d9a67313dec7ce1230852ab5c86352c5c +++ /dev/null @@ -1,2 +0,0 @@ -x%K -0@]se&DԛL!l).u.@_J0lM~v:mLiY*/@p W J&)* \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/16/5506a7408a482f50493434e13fffeb44af893f b/manage_externals/test/repos/simple-ext-fork.git/objects/16/5506a7408a482f50493434e13fffeb44af893f deleted file mode 100644 index 0d738af68b..0000000000 Binary files a/manage_externals/test/repos/simple-ext-fork.git/objects/16/5506a7408a482f50493434e13fffeb44af893f and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/24/4386e788c9bc608613e127a329c742450a60e4 b/manage_externals/test/repos/simple-ext-fork.git/objects/24/4386e788c9bc608613e127a329c742450a60e4 deleted file mode 100644 index b6284f8413..0000000000 Binary files a/manage_externals/test/repos/simple-ext-fork.git/objects/24/4386e788c9bc608613e127a329c742450a60e4 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/32/7e97d86e941047d809dba58f2804740c6c30cf b/manage_externals/test/repos/simple-ext-fork.git/objects/32/7e97d86e941047d809dba58f2804740c6c30cf deleted file mode 100644 index 0999f0d4b9..0000000000 Binary files a/manage_externals/test/repos/simple-ext-fork.git/objects/32/7e97d86e941047d809dba58f2804740c6c30cf and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/36/418b4e5665956a90725c9a1b5a8e551c5f3d48 b/manage_externals/test/repos/simple-ext-fork.git/objects/36/418b4e5665956a90725c9a1b5a8e551c5f3d48 deleted file mode 100644 index 9da8434f65..0000000000 Binary files a/manage_externals/test/repos/simple-ext-fork.git/objects/36/418b4e5665956a90725c9a1b5a8e551c5f3d48 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/3d/7099c35404ae6c8640ce263b38bef06e98cc26 b/manage_externals/test/repos/simple-ext-fork.git/objects/3d/7099c35404ae6c8640ce263b38bef06e98cc26 deleted file mode 100644 index 22065ba543..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/objects/3d/7099c35404ae6c8640ce263b38bef06e98cc26 +++ /dev/null @@ -1,2 +0,0 @@ -xmQ -0EQq $LހO_* t0J8͡bE?؋g4Nmbag[b{_Ic>`}0M؇Bs0/}:: \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/3d/ec1fdf8e2f5edba28148c5db2fe8d7a842360b b/manage_externals/test/repos/simple-ext-fork.git/objects/3d/ec1fdf8e2f5edba28148c5db2fe8d7a842360b deleted file mode 100644 index 9a31c7ef2e..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/objects/3d/ec1fdf8e2f5edba28148c5db2fe8d7a842360b +++ /dev/null @@ -1,2 +0,0 @@ -xKn0 )x,IEџA#t7o۶vp.zS&od8xLd@̋C6f% -pt$m&JdhݗVxp7^/o7dK1GDs#뿏{o?Z 7,\grPkSkJ^ \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/a4/2fe9144f5707bc1e9515ce1b44681f7aba6f95 b/manage_externals/test/repos/simple-ext-fork.git/objects/a4/2fe9144f5707bc1e9515ce1b44681f7aba6f95 deleted file mode 100644 index d8ba654548..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/objects/a4/2fe9144f5707bc1e9515ce1b44681f7aba6f95 +++ /dev/null @@ -1,3 +0,0 @@ -xU[ -0a@%Is+;c/DqV> wWJ ژ>8!!&'S=)CF+I2OTs^Xn`2Bcw'w -\NqݛF)83(2:0x-<׍!6,i 9 \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/b9/3737be3ea6b19f6255983748a0a0f4d622f936 b/manage_externals/test/repos/simple-ext-fork.git/objects/b9/3737be3ea6b19f6255983748a0a0f4d622f936 deleted file mode 100644 index 9b40a0afa0..0000000000 Binary files a/manage_externals/test/repos/simple-ext-fork.git/objects/b9/3737be3ea6b19f6255983748a0a0f4d622f936 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/c5/32bc8fde96fa63103a52057f0baffcc9f00c6b b/manage_externals/test/repos/simple-ext-fork.git/objects/c5/32bc8fde96fa63103a52057f0baffcc9f00c6b deleted file mode 100644 index 3019d2bac0..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/objects/c5/32bc8fde96fa63103a52057f0baffcc9f00c6b +++ /dev/null @@ -1 +0,0 @@ -x5 Dќb*dni Yl YX%bۖ,`W8 .G&ר-T$vڳp,=:-O}3u:]8慴k{|0 \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/c5/b315915742133dbdfbeed0753e481b55c1d364 b/manage_externals/test/repos/simple-ext-fork.git/objects/c5/b315915742133dbdfbeed0753e481b55c1d364 deleted file mode 100644 index 1d27accb58..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/objects/c5/b315915742133dbdfbeed0753e481b55c1d364 +++ /dev/null @@ -1 +0,0 @@ -x @TeV`p ;vɼ&מi+b%Ns(G7/nǩ-UlGjV&Y+!| \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/f2/68d4e56d067da9bd1d85e55bdc40a8bd2b0bca b/manage_externals/test/repos/simple-ext-fork.git/objects/f2/68d4e56d067da9bd1d85e55bdc40a8bd2b0bca deleted file mode 100644 index 3e945cdeb1..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/objects/f2/68d4e56d067da9bd1d85e55bdc40a8bd2b0bca +++ /dev/null @@ -1 +0,0 @@ -x 1ENӀcf+cFBw-ˁù2v0mzO^4rv7"̉z&sb$>D}D>Nv{ZMI?jps8gӽqڥZqo jfJ{]յOm/3$Q_@H \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext-fork.git/packed-refs b/manage_externals/test/repos/simple-ext-fork.git/packed-refs deleted file mode 100644 index b8f9e86308..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/packed-refs +++ /dev/null @@ -1,5 +0,0 @@ -# pack-refs with: peeled fully-peeled sorted -36418b4e5665956a90725c9a1b5a8e551c5f3d48 refs/heads/feature2 -9b75494003deca69527bb64bcaa352e801611dd2 refs/heads/master -11a76e3d9a67313dec7ce1230852ab5c86352c5c refs/tags/tag1 -^9b75494003deca69527bb64bcaa352e801611dd2 diff --git a/manage_externals/test/repos/simple-ext-fork.git/refs/heads/feature2 b/manage_externals/test/repos/simple-ext-fork.git/refs/heads/feature2 deleted file mode 100644 index d223b0362d..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/refs/heads/feature2 +++ /dev/null @@ -1 +0,0 @@ -f268d4e56d067da9bd1d85e55bdc40a8bd2b0bca diff --git a/manage_externals/test/repos/simple-ext-fork.git/refs/tags/abandoned-feature b/manage_externals/test/repos/simple-ext-fork.git/refs/tags/abandoned-feature deleted file mode 100644 index 8a18bf08e9..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/refs/tags/abandoned-feature +++ /dev/null @@ -1 +0,0 @@ -a42fe9144f5707bc1e9515ce1b44681f7aba6f95 diff --git a/manage_externals/test/repos/simple-ext-fork.git/refs/tags/forked-feature-v1 b/manage_externals/test/repos/simple-ext-fork.git/refs/tags/forked-feature-v1 deleted file mode 100644 index 2764b552d5..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/refs/tags/forked-feature-v1 +++ /dev/null @@ -1 +0,0 @@ -8d2b3b35126224c975d23f109aa1e3cbac452989 diff --git a/manage_externals/test/repos/simple-ext.git/HEAD b/manage_externals/test/repos/simple-ext.git/HEAD deleted file mode 100644 index cb089cd89a..0000000000 --- a/manage_externals/test/repos/simple-ext.git/HEAD +++ /dev/null @@ -1 +0,0 @@ -ref: refs/heads/master diff --git a/manage_externals/test/repos/simple-ext.git/config b/manage_externals/test/repos/simple-ext.git/config deleted file mode 100644 index e6da231579..0000000000 --- a/manage_externals/test/repos/simple-ext.git/config +++ /dev/null @@ -1,6 +0,0 @@ -[core] - repositoryformatversion = 0 - filemode = true - bare = true - ignorecase = true - precomposeunicode = true diff --git a/manage_externals/test/repos/simple-ext.git/description b/manage_externals/test/repos/simple-ext.git/description deleted file mode 100644 index 498b267a8c..0000000000 --- a/manage_externals/test/repos/simple-ext.git/description +++ /dev/null @@ -1 +0,0 @@ -Unnamed repository; edit this file 'description' to name the repository. diff --git a/manage_externals/test/repos/simple-ext.git/info/exclude b/manage_externals/test/repos/simple-ext.git/info/exclude deleted file mode 100644 index a5196d1be8..0000000000 --- a/manage_externals/test/repos/simple-ext.git/info/exclude +++ /dev/null @@ -1,6 +0,0 @@ -# git ls-files --others --exclude-from=.git/info/exclude -# Lines that start with '#' are comments. -# For a project mostly in C, the following would be a good set of -# exclude patterns (uncomment them if you want to use them): -# *.[oa] -# *~ diff --git a/manage_externals/test/repos/simple-ext.git/objects/00/fd13e76189f9134b0506b4b8ed3172723b467f b/manage_externals/test/repos/simple-ext.git/objects/00/fd13e76189f9134b0506b4b8ed3172723b467f deleted file mode 100644 index ae28c037e5..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/00/fd13e76189f9134b0506b4b8ed3172723b467f and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/09/0e1034746b2c865f7b0280813dbf4061a700e8 b/manage_externals/test/repos/simple-ext.git/objects/09/0e1034746b2c865f7b0280813dbf4061a700e8 deleted file mode 100644 index e5255047bf..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/09/0e1034746b2c865f7b0280813dbf4061a700e8 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/0b/15e8af3d4615b42314216efeae3fff184046a8 b/manage_externals/test/repos/simple-ext.git/objects/0b/15e8af3d4615b42314216efeae3fff184046a8 deleted file mode 100644 index 32d6896e3c..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/0b/15e8af3d4615b42314216efeae3fff184046a8 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/11/a76e3d9a67313dec7ce1230852ab5c86352c5c b/manage_externals/test/repos/simple-ext.git/objects/11/a76e3d9a67313dec7ce1230852ab5c86352c5c deleted file mode 100644 index 564e7bba63..0000000000 --- a/manage_externals/test/repos/simple-ext.git/objects/11/a76e3d9a67313dec7ce1230852ab5c86352c5c +++ /dev/null @@ -1,2 +0,0 @@ -x%K -0@]se&DԛL!l).u.@_J0lM~v:mLiY*/@p W J&)* \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext.git/objects/14/2711fdbbcb8034d7cad6bae6801887b12fe61d b/manage_externals/test/repos/simple-ext.git/objects/14/2711fdbbcb8034d7cad6bae6801887b12fe61d deleted file mode 100644 index acaf7889b4..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/14/2711fdbbcb8034d7cad6bae6801887b12fe61d and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/31/dbcd6de441e671a467ef317146539b7ffabb11 b/manage_externals/test/repos/simple-ext.git/objects/31/dbcd6de441e671a467ef317146539b7ffabb11 deleted file mode 100644 index 0f0db6797f..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/31/dbcd6de441e671a467ef317146539b7ffabb11 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/36/418b4e5665956a90725c9a1b5a8e551c5f3d48 b/manage_externals/test/repos/simple-ext.git/objects/36/418b4e5665956a90725c9a1b5a8e551c5f3d48 deleted file mode 100644 index 9da8434f65..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/36/418b4e5665956a90725c9a1b5a8e551c5f3d48 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 b/manage_externals/test/repos/simple-ext.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 deleted file mode 100644 index f65234e17f..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/60/7ec299c17dd285c029edc41a0109e49d441380 b/manage_externals/test/repos/simple-ext.git/objects/60/7ec299c17dd285c029edc41a0109e49d441380 deleted file mode 100644 index 3f6959cc54..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/60/7ec299c17dd285c029edc41a0109e49d441380 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/60/b1cc1a38d63a4bcaa1e767262bbe23dbf9f5f5 b/manage_externals/test/repos/simple-ext.git/objects/60/b1cc1a38d63a4bcaa1e767262bbe23dbf9f5f5 deleted file mode 100644 index 68a86c24ea..0000000000 --- a/manage_externals/test/repos/simple-ext.git/objects/60/b1cc1a38d63a4bcaa1e767262bbe23dbf9f5f5 +++ /dev/null @@ -1,2 +0,0 @@ -xQ {XXdc7Y`ۚo=/3uoPw6YB9MĜc&iښy˦KK9() -Raq$)+| ȧ nMᜟik(|GFkN{]X+, xoC# \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext.git/objects/63/a99393d1baff97ccef967af30380659867b139 b/manage_externals/test/repos/simple-ext.git/objects/63/a99393d1baff97ccef967af30380659867b139 deleted file mode 100644 index efe17af8fd..0000000000 --- a/manage_externals/test/repos/simple-ext.git/objects/63/a99393d1baff97ccef967af30380659867b139 +++ /dev/null @@ -1 +0,0 @@ -x5 B1=W b@bf!7dWE0LVmýc᲏N=09%l~hP?rPkևЏ)]5yB.mg4ns$* \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext.git/objects/95/3256da5612fcd9263590a353bc18c6f224e74f b/manage_externals/test/repos/simple-ext.git/objects/95/3256da5612fcd9263590a353bc18c6f224e74f deleted file mode 100644 index 6187628628..0000000000 --- a/manage_externals/test/repos/simple-ext.git/objects/95/3256da5612fcd9263590a353bc18c6f224e74f +++ /dev/null @@ -1 +0,0 @@ -x ʱ 0 DԚ&HeO$Edd/] lXe\A7h#wTN){Js-k)=jh2^kH$ \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext.git/objects/9b/75494003deca69527bb64bcaa352e801611dd2 b/manage_externals/test/repos/simple-ext.git/objects/9b/75494003deca69527bb64bcaa352e801611dd2 deleted file mode 100644 index ba1b51f515..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/9b/75494003deca69527bb64bcaa352e801611dd2 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/a2/2a5da9119328ea6d693f88861457c07e14ac04 b/manage_externals/test/repos/simple-ext.git/objects/a2/2a5da9119328ea6d693f88861457c07e14ac04 deleted file mode 100644 index fb5feb96c2..0000000000 --- a/manage_externals/test/repos/simple-ext.git/objects/a2/2a5da9119328ea6d693f88861457c07e14ac04 +++ /dev/null @@ -1 +0,0 @@ -x 0 @;ś?Z&nǕnM kt"a.a-Ѡ>rPkSkJ^ \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext.git/objects/b7/692b6d391899680da7b9b6fd8af4c413f06fe7 b/manage_externals/test/repos/simple-ext.git/objects/b7/692b6d391899680da7b9b6fd8af4c413f06fe7 deleted file mode 100644 index 1b3b272442..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/b7/692b6d391899680da7b9b6fd8af4c413f06fe7 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/c5/b315915742133dbdfbeed0753e481b55c1d364 b/manage_externals/test/repos/simple-ext.git/objects/c5/b315915742133dbdfbeed0753e481b55c1d364 deleted file mode 100644 index 1d27accb58..0000000000 --- a/manage_externals/test/repos/simple-ext.git/objects/c5/b315915742133dbdfbeed0753e481b55c1d364 +++ /dev/null @@ -1 +0,0 @@ -x @TeV`p ;vɼ&מi+b%Ns(G7/nǩ-UlGjV&Y+!| \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext.git/objects/d1/163870d19c3dee34fada3a76b785cfa2a8424b b/manage_externals/test/repos/simple-ext.git/objects/d1/163870d19c3dee34fada3a76b785cfa2a8424b deleted file mode 100644 index 04e760363a..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/d1/163870d19c3dee34fada3a76b785cfa2a8424b and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/d8/ed2f33179d751937f8fde2e33921e4827babf4 b/manage_externals/test/repos/simple-ext.git/objects/d8/ed2f33179d751937f8fde2e33921e4827babf4 deleted file mode 100644 index f08ae820c9..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/d8/ed2f33179d751937f8fde2e33921e4827babf4 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/df/312890f93ba4d2c694208599b665c4a08afeff b/manage_externals/test/repos/simple-ext.git/objects/df/312890f93ba4d2c694208599b665c4a08afeff deleted file mode 100644 index 4018ea5914..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/df/312890f93ba4d2c694208599b665c4a08afeff and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/refs/heads/feature2 b/manage_externals/test/repos/simple-ext.git/refs/heads/feature2 deleted file mode 100644 index 01a0dd6e23..0000000000 --- a/manage_externals/test/repos/simple-ext.git/refs/heads/feature2 +++ /dev/null @@ -1 +0,0 @@ -36418b4e5665956a90725c9a1b5a8e551c5f3d48 diff --git a/manage_externals/test/repos/simple-ext.git/refs/heads/feature3 b/manage_externals/test/repos/simple-ext.git/refs/heads/feature3 deleted file mode 100644 index dd24079fce..0000000000 --- a/manage_externals/test/repos/simple-ext.git/refs/heads/feature3 +++ /dev/null @@ -1 +0,0 @@ -090e1034746b2c865f7b0280813dbf4061a700e8 diff --git a/manage_externals/test/repos/simple-ext.git/refs/heads/master b/manage_externals/test/repos/simple-ext.git/refs/heads/master deleted file mode 100644 index adf1ccb002..0000000000 --- a/manage_externals/test/repos/simple-ext.git/refs/heads/master +++ /dev/null @@ -1 +0,0 @@ -607ec299c17dd285c029edc41a0109e49d441380 diff --git a/manage_externals/test/repos/simple-ext.git/refs/tags/tag1 b/manage_externals/test/repos/simple-ext.git/refs/tags/tag1 deleted file mode 100644 index ee595be8bd..0000000000 --- a/manage_externals/test/repos/simple-ext.git/refs/tags/tag1 +++ /dev/null @@ -1 +0,0 @@ -11a76e3d9a67313dec7ce1230852ab5c86352c5c diff --git a/manage_externals/test/repos/simple-ext.git/refs/tags/tag2 b/manage_externals/test/repos/simple-ext.git/refs/tags/tag2 deleted file mode 100644 index 4160b6c494..0000000000 --- a/manage_externals/test/repos/simple-ext.git/refs/tags/tag2 +++ /dev/null @@ -1 +0,0 @@ -b7692b6d391899680da7b9b6fd8af4c413f06fe7 diff --git a/manage_externals/test/requirements.txt b/manage_externals/test/requirements.txt deleted file mode 100644 index d66f6f1e67..0000000000 --- a/manage_externals/test/requirements.txt +++ /dev/null @@ -1,5 +0,0 @@ -pylint>=1.7.0 -autopep8>=1.3.0 -coverage>=4.4.0 -coveralls>=1.2.0 -sphinx>=1.6.0 diff --git a/manage_externals/test/test_sys_checkout.py b/manage_externals/test/test_sys_checkout.py deleted file mode 100644 index ab4f77e88f..0000000000 --- a/manage_externals/test/test_sys_checkout.py +++ /dev/null @@ -1,1896 +0,0 @@ -#!/usr/bin/env python3 - -"""Unit test driver for checkout_externals - -Terminology: - * 'container': a repo that has externals - * 'simple': a repo that has no externals, but is referenced as an external by another repo. - * 'mixed': a repo that both has externals and is referenced as an external by another repo. - - * 'clean': the local repo matches the version in the externals and has no local modifications. - * 'empty': the external isn't checked out at all. - -Note: this script assume the path to the manic and -checkout_externals module is already in the python path. This is -usually handled by the makefile. If you call it directly, you may need -to adjust your path. - -NOTE(bja, 2017-11) If a test fails, we want to keep the repo for that -test. But the tests will keep running, so we need a unique name. Also, -tearDown is always called after each test. I haven't figured out how -to determine if an assertion failed and whether it is safe to clean up -the test repos. - -So the solution is: - -* assign a unique id to each test repo. - -* never cleanup during the run. - -* Erase any existing repos at the begining of the module in -setUpModule. -""" - -# NOTE(bja, 2017-11) pylint complains that the module is too big, but -# I'm still working on how to break up the tests and still have the -# temporary directory be preserved.... -# pylint: disable=too-many-lines - - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import logging -import os -import os.path -import shutil -import unittest - -from manic.externals_description import ExternalsDescription -from manic.externals_description import DESCRIPTION_SECTION, VERSION_ITEM -from manic.externals_description import git_submodule_status -from manic.externals_status import ExternalStatus -from manic.repository_git import GitRepository -from manic.utils import printlog, execute_subprocess -from manic.global_constants import LOCAL_PATH_INDICATOR, VERBOSITY_DEFAULT -from manic.global_constants import LOG_FILE_NAME -from manic import checkout - -# ConfigParser was renamed in python2 to configparser. In python2, -# ConfigParser returns byte strings, str, instead of unicode. We need -# unicode to be compatible with xml and json parser and python3. -try: - # python2 - from ConfigParser import SafeConfigParser as config_parser -except ImportError: - # python3 - from configparser import ConfigParser as config_parser - -# --------------------------------------------------------------------- -# -# Global constants -# -# --------------------------------------------------------------------- - - -# Module-wide root directory for all the per-test subdirs we'll create on -# the fly (which are placed under wherever $CWD is when the test runs). -# Set by setupModule(). -module_tmp_root_dir = None -TMP_REPO_DIR_NAME = 'tmp' # subdir under $CWD - -# subdir under test/ that holds all of our checked-in repositories (which we -# will clone for these tests). -BARE_REPO_ROOT_NAME = 'repos' - -# Environment var referenced by checked-in externals file in mixed-cont-ext.git, -# which should be pointed to the fully-resolved BARE_REPO_ROOT_NAME directory. -# We explicitly clear this after every test, via tearDown(). -MIXED_CONT_EXT_ROOT_ENV_VAR = 'MANIC_TEST_BARE_REPO_ROOT' - -# Subdirs under bare repo root, each holding a repository. For more info -# on the contents of these repositories, see test/repos/README.md. In these -# tests the 'parent' repos are cloned as a starting point, whereas the 'child' -# repos are checked out when the tests run checkout_externals. -CONTAINER_REPO = 'container.git' # Parent repo -SIMPLE_REPO = 'simple-ext.git' # Child repo -SIMPLE_FORK_REPO = 'simple-ext-fork.git' # Child repo -MIXED_REPO = 'mixed-cont-ext.git' # Both parent and child - -# Standard (arbitrary) external names for test configs -TAG_SECTION = 'simp_tag' -BRANCH_SECTION = 'simp_branch' -HASH_SECTION = 'simp_hash' - -# All the configs we construct check out their externals into these local paths. -EXTERNALS_PATH = 'externals' -SUB_EXTERNALS_PATH = 'src' # For mixed test repos, - -# For testing behavior with '.' instead of an explicit paths. -SIMPLE_LOCAL_ONLY_NAME = '.' - -# Externals files. -CFG_NAME = 'externals.cfg' # We construct this on a per-test basis. -CFG_SUB_NAME = 'sub-externals.cfg' # Already exists in mixed-cont-ext repo. - -# Arbitrary text file in all the test repos. -README_NAME = 'readme.txt' - -# Branch that exists in both the simple and simple-fork repos. -REMOTE_BRANCH_FEATURE2 = 'feature2' - -SVN_TEST_REPO = 'https://github.com/escomp/cesm' - -# Disable too-many-public-methods error -# pylint: disable=R0904 - -def setUpModule(): # pylint: disable=C0103 - """Setup for all tests in this module. It is called once per module! - """ - logging.basicConfig(filename=LOG_FILE_NAME, - format='%(levelname)s : %(asctime)s : %(message)s', - datefmt='%Y-%m-%d %H:%M:%S', - level=logging.DEBUG) - repo_root = os.path.join(os.getcwd(), TMP_REPO_DIR_NAME) - repo_root = os.path.abspath(repo_root) - # delete if it exists from previous runs - try: - shutil.rmtree(repo_root) - except BaseException: - pass - # create clean dir for this run - os.mkdir(repo_root) - - # Make available to all tests in this file. - global module_tmp_root_dir - assert module_tmp_root_dir == None, module_tmp_root_dir - module_tmp_root_dir = repo_root - - -class RepoUtils(object): - """Convenience methods for interacting with git repos.""" - @staticmethod - def create_branch(repo_base_dir, external_name, branch, with_commit=False): - """Create branch and optionally (with_commit) add a single commit. - """ - # pylint: disable=R0913 - cwd = os.getcwd() - repo_root = os.path.join(repo_base_dir, EXTERNALS_PATH, external_name) - os.chdir(repo_root) - cmd = ['git', 'checkout', '-b', branch, ] - execute_subprocess(cmd) - if with_commit: - msg = 'start work on {0}'.format(branch) - with open(README_NAME, 'a') as handle: - handle.write(msg) - cmd = ['git', 'add', README_NAME, ] - execute_subprocess(cmd) - cmd = ['git', 'commit', '-m', msg, ] - execute_subprocess(cmd) - os.chdir(cwd) - - @staticmethod - def create_commit(repo_base_dir, external_name): - """Make a commit to the given external. - - This is used to test sync state changes from local commits on - detached heads and tracking branches. - """ - cwd = os.getcwd() - repo_root = os.path.join(repo_base_dir, EXTERNALS_PATH, external_name) - os.chdir(repo_root) - - msg = 'work on great new feature!' - with open(README_NAME, 'a') as handle: - handle.write(msg) - cmd = ['git', 'add', README_NAME, ] - execute_subprocess(cmd) - cmd = ['git', 'commit', '-m', msg, ] - execute_subprocess(cmd) - os.chdir(cwd) - - @staticmethod - def clone_test_repo(bare_root, test_id, parent_repo_name, dest_dir_in): - """Clone repo at / into dest_dir_in or local per-test-subdir. - - Returns output dir. - """ - parent_repo_dir = os.path.join(bare_root, parent_repo_name) - if dest_dir_in is None: - # create unique subdir for this test - test_dir_name = test_id - print("Test repository name: {0}".format(test_dir_name)) - dest_dir = os.path.join(module_tmp_root_dir, test_dir_name) - else: - dest_dir = dest_dir_in - - # pylint: disable=W0212 - GitRepository._git_clone(parent_repo_dir, dest_dir, VERBOSITY_DEFAULT) - return dest_dir - - @staticmethod - def add_file_to_repo(under_test_dir, filename, tracked): - """Add a file to the repository so we can put it into a dirty state - - """ - cwd = os.getcwd() - os.chdir(under_test_dir) - with open(filename, 'w') as tmp: - tmp.write('Hello, world!') - - if tracked: - # NOTE(bja, 2018-01) brittle hack to obtain repo dir and - # file name - path_data = filename.split('/') - repo_dir = os.path.join(path_data[0], path_data[1]) - os.chdir(repo_dir) - tracked_file = path_data[2] - cmd = ['git', 'add', tracked_file] - execute_subprocess(cmd) - - os.chdir(cwd) - -class GenerateExternalsDescriptionCfgV1(object): - """Building blocks to create ExternalsDescriptionCfgV1 files. - - Basic usage: create_config() multiple create_*(), then write_config(). - Optionally after that: write_with_*(). - """ - - def __init__(self, bare_root): - self._schema_version = '1.1.0' - self._config = None - - # directory where we have test repositories (which we will clone for - # tests) - self._bare_root = bare_root - - def write_config(self, dest_dir, filename=CFG_NAME): - """Write self._config to disk - - """ - dest_path = os.path.join(dest_dir, filename) - with open(dest_path, 'w') as configfile: - self._config.write(configfile) - - def create_config(self): - """Create an config object and add the required metadata section - - """ - self._config = config_parser() - self.create_metadata() - - def create_metadata(self): - """Create the metadata section of the config file - """ - self._config.add_section(DESCRIPTION_SECTION) - - self._config.set(DESCRIPTION_SECTION, VERSION_ITEM, - self._schema_version) - - def url_for_repo_path(self, repo_path, repo_path_abs=None): - if repo_path_abs is not None: - return repo_path_abs - else: - return os.path.join(self._bare_root, repo_path) - - def create_section(self, repo_path, name, tag='', branch='', - ref_hash='', required=True, path=EXTERNALS_PATH, - sub_externals='', repo_path_abs=None, from_submodule=False, - sparse='', nested=False): - # pylint: disable=too-many-branches - """Create a config ExternalsDescription section with the given name. - - Autofills some items and handles some optional items. - - repo_path_abs overrides repo_path (which is relative to the bare repo) - path is a subdir under repo_path to check out to. - """ - # pylint: disable=R0913 - self._config.add_section(name) - if not from_submodule: - if nested: - self._config.set(name, ExternalsDescription.PATH, path) - else: - self._config.set(name, ExternalsDescription.PATH, - os.path.join(path, name)) - - self._config.set(name, ExternalsDescription.PROTOCOL, - ExternalsDescription.PROTOCOL_GIT) - - # from_submodules is incompatible with some other options, turn them off - if (from_submodule and - ((repo_path_abs is not None) or tag or ref_hash or branch)): - printlog('create_section: "from_submodule" is incompatible with ' - '"repo_url", "tag", "hash", and "branch" options;\n' - 'Ignoring those options for {}'.format(name)) - repo_url = None - tag = '' - ref_hash = '' - branch = '' - - repo_url = self.url_for_repo_path(repo_path, repo_path_abs) - - if not from_submodule: - self._config.set(name, ExternalsDescription.REPO_URL, repo_url) - - self._config.set(name, ExternalsDescription.REQUIRED, str(required)) - - if tag: - self._config.set(name, ExternalsDescription.TAG, tag) - - if branch: - self._config.set(name, ExternalsDescription.BRANCH, branch) - - if ref_hash: - self._config.set(name, ExternalsDescription.HASH, ref_hash) - - if sub_externals: - self._config.set(name, ExternalsDescription.EXTERNALS, - sub_externals) - - if sparse: - self._config.set(name, ExternalsDescription.SPARSE, sparse) - - if from_submodule: - self._config.set(name, ExternalsDescription.SUBMODULE, "True") - - def create_section_reference_to_subexternal(self, name): - """Just a reference to another externals file. - - """ - # pylint: disable=R0913 - self._config.add_section(name) - self._config.set(name, ExternalsDescription.PATH, LOCAL_PATH_INDICATOR) - - self._config.set(name, ExternalsDescription.PROTOCOL, - ExternalsDescription.PROTOCOL_EXTERNALS_ONLY) - - self._config.set(name, ExternalsDescription.REPO_URL, - LOCAL_PATH_INDICATOR) - - self._config.set(name, ExternalsDescription.REQUIRED, str(True)) - - self._config.set(name, ExternalsDescription.EXTERNALS, CFG_SUB_NAME) - - def create_svn_external(self, name, tag='', branch=''): - """Create a config section for an svn repository. - - """ - self._config.add_section(name) - self._config.set(name, ExternalsDescription.PATH, - os.path.join(EXTERNALS_PATH, name)) - - self._config.set(name, ExternalsDescription.PROTOCOL, - ExternalsDescription.PROTOCOL_SVN) - - self._config.set(name, ExternalsDescription.REPO_URL, SVN_TEST_REPO) - - self._config.set(name, ExternalsDescription.REQUIRED, str(True)) - - if tag: - self._config.set(name, ExternalsDescription.TAG, tag) - - if branch: - self._config.set(name, ExternalsDescription.BRANCH, branch) - - def write_with_git_branch(self, dest_dir, name, branch, new_remote_repo_path=None): - """Update fields in our config and write it to disk. - - name is the key of the ExternalsDescription in self._config to update. - """ - # pylint: disable=R0913 - self._config.set(name, ExternalsDescription.BRANCH, branch) - - if new_remote_repo_path: - if new_remote_repo_path == SIMPLE_LOCAL_ONLY_NAME: - repo_url = SIMPLE_LOCAL_ONLY_NAME - else: - repo_url = os.path.join(self._bare_root, new_remote_repo_path) - self._config.set(name, ExternalsDescription.REPO_URL, repo_url) - - try: - # remove the tag if it existed - self._config.remove_option(name, ExternalsDescription.TAG) - except BaseException: - pass - - self.write_config(dest_dir) - - def write_with_svn_branch(self, dest_dir, name, branch): - """Update a repository branch, and potentially the remote. - """ - # pylint: disable=R0913 - self._config.set(name, ExternalsDescription.BRANCH, branch) - - try: - # remove the tag if it existed - self._config.remove_option(name, ExternalsDescription.TAG) - except BaseException: - pass - - self.write_config(dest_dir) - - def write_with_tag_and_remote_repo(self, dest_dir, name, tag, new_remote_repo_path, - remove_branch=True): - """Update a repository tag and the remote. - - NOTE(bja, 2017-11) remove_branch=False should result in an - overspecified external with both a branch and tag. This is - used for error condition testing. - - """ - # pylint: disable=R0913 - self._config.set(name, ExternalsDescription.TAG, tag) - - if new_remote_repo_path: - repo_url = os.path.join(self._bare_root, new_remote_repo_path) - self._config.set(name, ExternalsDescription.REPO_URL, repo_url) - - try: - # remove the branch if it existed - if remove_branch: - self._config.remove_option(name, ExternalsDescription.BRANCH) - except BaseException: - pass - - self.write_config(dest_dir) - - def write_without_branch_tag(self, dest_dir, name): - """Update a repository protocol, and potentially the remote - """ - # pylint: disable=R0913 - try: - # remove the branch if it existed - self._config.remove_option(name, ExternalsDescription.BRANCH) - except BaseException: - pass - - try: - # remove the tag if it existed - self._config.remove_option(name, ExternalsDescription.TAG) - except BaseException: - pass - - self.write_config(dest_dir) - - def write_without_repo_url(self, dest_dir, name): - """Update a repository protocol, and potentially the remote - """ - # pylint: disable=R0913 - try: - # remove the repo url if it existed - self._config.remove_option(name, ExternalsDescription.REPO_URL) - except BaseException: - pass - - self.write_config(dest_dir) - - def write_with_protocol(self, dest_dir, name, protocol, repo_path=None): - """Update a repository protocol, and potentially the remote - """ - # pylint: disable=R0913 - self._config.set(name, ExternalsDescription.PROTOCOL, protocol) - - if repo_path: - repo_url = os.path.join(self._bare_root, repo_path) - self._config.set(name, ExternalsDescription.REPO_URL, repo_url) - - self.write_config(dest_dir) - - -def _execute_checkout_in_dir(dirname, args, debug_env=''): - """Execute the checkout command in the appropriate repo dir with the - specified additional args. - - args should be a list of strings. - debug_env shuld be a string of the form 'FOO=bar' or the empty string. - - Note that we are calling the command line processing and main - routines and not using a subprocess call so that we get code - coverage results! Note this means that environment variables are passed - to checkout_externals via os.environ; debug_env is just used to aid - manual reproducibility of a given call. - - Returns (overall_status, tree_status) - where overall_status is 0 for success, nonzero otherwise. - and tree_status is set if --status was passed in, None otherwise. - - Note this command executes the checkout command, it doesn't - necessarily do any checking out (e.g. if --status is passed in). - """ - cwd = os.getcwd() - - # Construct a command line for reproducibility; this command is not - # actually executed in the test. - os.chdir(dirname) - cmdline = ['--externals', CFG_NAME, ] - cmdline += args - manual_cmd = ('Running equivalent of:\n' - 'pushd {dirname}; ' - '{debug_env} /path/to/checkout_externals {args}'.format( - dirname=dirname, debug_env=debug_env, - args=' '.join(cmdline))) - printlog(manual_cmd) - options = checkout.commandline_arguments(cmdline) - overall_status, tree_status = checkout.main(options) - os.chdir(cwd) - return overall_status, tree_status - -class BaseTestSysCheckout(unittest.TestCase): - """Base class of reusable systems level test setup for - checkout_externals - - """ - # NOTE(bja, 2017-11) pylint complains about long method names, but - # it is hard to differentiate tests without making them more - # cryptic. - # pylint: disable=invalid-name - - # Command-line args for checkout_externals, used in execute_checkout_in_dir() - status_args = ['--status'] - checkout_args = [] - optional_args = ['--optional'] - verbose_args = ['--status', '--verbose'] - - def setUp(self): - """Setup for all individual checkout_externals tests - """ - # directory we want to return to after the test system and - # checkout_externals are done cd'ing all over the place. - self._return_dir = os.getcwd() - - self._test_id = self.id().split('.')[-1] - - # find root - if os.path.exists(os.path.join(os.getcwd(), 'checkout_externals')): - root_dir = os.path.abspath(os.getcwd()) - else: - # maybe we are in a subdir, search up - root_dir = os.path.abspath(os.path.join(os.getcwd(), os.pardir)) - while os.path.basename(root_dir): - if os.path.exists(os.path.join(root_dir, 'checkout_externals')): - break - root_dir = os.path.dirname(root_dir) - - if not os.path.exists(os.path.join(root_dir, 'checkout_externals')): - raise RuntimeError('Cannot find checkout_externals') - - # path to the executable - self._checkout = os.path.join(root_dir, 'checkout_externals') - - # directory where we have test repositories (which we will clone for - # tests) - self._bare_root = os.path.abspath( - os.path.join(root_dir, 'test', BARE_REPO_ROOT_NAME)) - - # set the input file generator - self._generator = GenerateExternalsDescriptionCfgV1(self._bare_root) - # set the input file generator for secondary externals - self._sub_generator = GenerateExternalsDescriptionCfgV1(self._bare_root) - - def tearDown(self): - """Tear down for individual tests - """ - # return to our common starting point - os.chdir(self._return_dir) - - # (in case this was set) Don't pollute environment of other tests. - os.environ.pop(MIXED_CONT_EXT_ROOT_ENV_VAR, - None) # Don't care if key wasn't set. - - def clone_test_repo(self, parent_repo_name, dest_dir_in=None): - """Clones repo under self._bare_root""" - return RepoUtils.clone_test_repo(self._bare_root, self._test_id, - parent_repo_name, dest_dir_in) - - def execute_checkout_in_dir(self, dirname, args, debug_env=''): - overall_status, tree_status = _execute_checkout_in_dir(dirname, args, - debug_env=debug_env) - self.assertEqual(overall_status, 0) - return tree_status - - def execute_checkout_with_status(self, dirname, args, debug_env=''): - """Calls checkout a second time to get status if needed.""" - tree_status = self.execute_checkout_in_dir( - dirname, args, debug_env=debug_env) - if tree_status is None: - tree_status = self.execute_checkout_in_dir(dirname, - self.status_args, - debug_env=debug_env) - self.assertNotEqual(tree_status, None) - return tree_status - - def _check_sync_clean(self, ext_status, expected_sync_state, - expected_clean_state): - self.assertEqual(ext_status.sync_state, expected_sync_state) - self.assertEqual(ext_status.clean_state, expected_clean_state) - - @staticmethod - def _external_path(section_name, base_path=EXTERNALS_PATH): - return './{0}/{1}'.format(base_path, section_name) - - def _check_file_exists(self, repo_dir, pathname): - "Check that exists in " - self.assertTrue(os.path.exists(os.path.join(repo_dir, pathname))) - - def _check_file_absent(self, repo_dir, pathname): - "Check that does not exist in " - self.assertFalse(os.path.exists(os.path.join(repo_dir, pathname))) - - -class TestSysCheckout(BaseTestSysCheckout): - """Run systems level tests of checkout_externals - """ - # NOTE(bja, 2017-11) pylint complains about long method names, but - # it is hard to differentiate tests without making them more - # cryptic. - # pylint: disable=invalid-name - - # ---------------------------------------------------------------- - # - # Run systems tests - # - # ---------------------------------------------------------------- - def test_required_bytag(self): - """Check out a required external pointing to a git tag.""" - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - self._generator.create_config() - self._generator.create_section(SIMPLE_REPO, TAG_SECTION, - tag='tag1') - self._generator.write_config(cloned_repo_dir) - - # externals start out 'empty' aka not checked out. - tree = self.execute_checkout_in_dir(cloned_repo_dir, - self.status_args) - local_path_rel = self._external_path(TAG_SECTION) - self._check_sync_clean(tree[local_path_rel], - ExternalStatus.EMPTY, - ExternalStatus.DEFAULT) - local_path_abs = os.path.join(cloned_repo_dir, local_path_rel) - self.assertFalse(os.path.exists(local_path_abs)) - - # after checkout, the external is 'clean' aka at the correct version. - tree = self.execute_checkout_with_status(cloned_repo_dir, - self.checkout_args) - self._check_sync_clean(tree[local_path_rel], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - # Actually checked out the desired repo. - self.assertEqual('origin', GitRepository._remote_name_for_url( - # Which url to look up - self._generator.url_for_repo_path(SIMPLE_REPO), - # Which directory has the local checked-out repo. - dirname=local_path_abs)) - - # Actually checked out the desired tag. - (tag_found, tag_name) = GitRepository._git_current_tag(local_path_abs) - self.assertEqual(tag_name, 'tag1') - - # Check existence of some simp_tag files - tag_path = os.path.join('externals', TAG_SECTION) - self._check_file_exists(cloned_repo_dir, - os.path.join(tag_path, README_NAME)) - # Subrepo should not exist (not referenced by configs). - self._check_file_absent(cloned_repo_dir, os.path.join(tag_path, - 'simple_subdir', - 'subdir_file.txt')) - - def test_required_bybranch(self): - """Check out a required external pointing to a git branch.""" - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - self._generator.create_config() - self._generator.create_section(SIMPLE_REPO, BRANCH_SECTION, - branch=REMOTE_BRANCH_FEATURE2) - self._generator.write_config(cloned_repo_dir) - - # externals start out 'empty' aka not checked out. - tree = self.execute_checkout_in_dir(cloned_repo_dir, - self.status_args) - local_path_rel = self._external_path(BRANCH_SECTION) - self._check_sync_clean(tree[local_path_rel], - ExternalStatus.EMPTY, - ExternalStatus.DEFAULT) - local_path_abs = os.path.join(cloned_repo_dir, local_path_rel) - self.assertFalse(os.path.exists(local_path_abs)) - - # after checkout, the external is 'clean' aka at the correct version. - tree = self.execute_checkout_with_status(cloned_repo_dir, - self.checkout_args) - self._check_sync_clean(tree[local_path_rel], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - self.assertTrue(os.path.exists(local_path_abs)) - - # Actually checked out the desired repo. - self.assertEqual('origin', GitRepository._remote_name_for_url( - # Which url to look up - self._generator.url_for_repo_path(SIMPLE_REPO), - # Which directory has the local checked-out repo. - dirname=local_path_abs)) - - # Actually checked out the desired branch. - (branch_found, branch_name) = GitRepository._git_current_remote_branch( - local_path_abs) - self.assertEquals(branch_name, 'origin/' + REMOTE_BRANCH_FEATURE2) - - def test_required_byhash(self): - """Check out a required external pointing to a git hash.""" - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - self._generator.create_config() - self._generator.create_section(SIMPLE_REPO, HASH_SECTION, - ref_hash='60b1cc1a38d63') - self._generator.write_config(cloned_repo_dir) - - # externals start out 'empty' aka not checked out. - tree = self.execute_checkout_in_dir(cloned_repo_dir, - self.status_args) - local_path_rel = self._external_path(HASH_SECTION) - self._check_sync_clean(tree[local_path_rel], - ExternalStatus.EMPTY, - ExternalStatus.DEFAULT) - local_path_abs = os.path.join(cloned_repo_dir, local_path_rel) - self.assertFalse(os.path.exists(local_path_abs)) - - # after checkout, the externals are 'clean' aka at their correct version. - tree = self.execute_checkout_with_status(cloned_repo_dir, - self.checkout_args) - self._check_sync_clean(tree[local_path_rel], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - # Actually checked out the desired repo. - self.assertEqual('origin', GitRepository._remote_name_for_url( - # Which url to look up - self._generator.url_for_repo_path(SIMPLE_REPO), - # Which directory has the local checked-out repo. - dirname=local_path_abs)) - - # Actually checked out the desired hash. - (hash_found, hash_name) = GitRepository._git_current_hash( - local_path_abs) - self.assertTrue(hash_name.startswith('60b1cc1a38d63'), - msg=hash_name) - - def test_container_nested_required(self): - """Verify that a container with nested subrepos generates the correct initial status. - Tests over all possible permutations - """ - # Output subdirs for each of the externals, to test that one external can be - # checked out in a subdir of another. - NESTED_SUBDIR = ['./fred', './fred/wilma', './fred/wilma/barney'] - - # Assert that each type of external (e.g. tag vs branch) can be at any parent level - # (e.g. child/parent/grandparent). - orders = [[0, 1, 2], [1, 2, 0], [2, 0, 1], - [0, 2, 1], [2, 1, 0], [1, 0, 2]] - for n, order in enumerate(orders): - dest_dir = os.path.join(module_tmp_root_dir, self._test_id, - "test"+str(n)) - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO, - dest_dir_in=dest_dir) - self._generator.create_config() - # We happen to check out each section via a different reference (tag/branch/hash) but - # those don't really matter, we just need to check out three repos into a nested set of - # directories. - self._generator.create_section( - SIMPLE_REPO, TAG_SECTION, nested=True, - tag='tag1', path=NESTED_SUBDIR[order[0]]) - self._generator.create_section( - SIMPLE_REPO, BRANCH_SECTION, nested=True, - branch=REMOTE_BRANCH_FEATURE2, path=NESTED_SUBDIR[order[1]]) - self._generator.create_section( - SIMPLE_REPO, HASH_SECTION, nested=True, - ref_hash='60b1cc1a38d63', path=NESTED_SUBDIR[order[2]]) - self._generator.write_config(cloned_repo_dir) - - # all externals start out 'empty' aka not checked out. - tree = self.execute_checkout_in_dir(cloned_repo_dir, - self.status_args) - self._check_sync_clean(tree[NESTED_SUBDIR[order[0]]], - ExternalStatus.EMPTY, - ExternalStatus.DEFAULT) - self._check_sync_clean(tree[NESTED_SUBDIR[order[1]]], - ExternalStatus.EMPTY, - ExternalStatus.DEFAULT) - self._check_sync_clean(tree[NESTED_SUBDIR[order[2]]], - ExternalStatus.EMPTY, - ExternalStatus.DEFAULT) - - # after checkout, all the repos are 'clean'. - tree = self.execute_checkout_with_status(cloned_repo_dir, - self.checkout_args) - self._check_sync_clean(tree[NESTED_SUBDIR[order[0]]], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - self._check_sync_clean(tree[NESTED_SUBDIR[order[1]]], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - self._check_sync_clean(tree[NESTED_SUBDIR[order[2]]], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - def test_container_simple_optional(self): - """Verify that container with an optional simple subrepos generates - the correct initial status. - - """ - # create repo and externals config. - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - self._generator.create_config() - self._generator.create_section(SIMPLE_REPO, 'simp_req', - tag='tag1') - - self._generator.create_section(SIMPLE_REPO, 'simp_opt', - tag='tag1', required=False) - - self._generator.write_config(cloned_repo_dir) - - # all externals start out 'empty' aka not checked out. - tree = self.execute_checkout_in_dir(cloned_repo_dir, - self.status_args) - req_status = tree[self._external_path('simp_req')] - self._check_sync_clean(req_status, - ExternalStatus.EMPTY, - ExternalStatus.DEFAULT) - self.assertEqual(req_status.source_type, ExternalStatus.MANAGED) - - opt_status = tree[self._external_path('simp_opt')] - self._check_sync_clean(opt_status, - ExternalStatus.EMPTY, - ExternalStatus.DEFAULT) - self.assertEqual(opt_status.source_type, ExternalStatus.OPTIONAL) - - # after checkout, required external is clean, optional is still empty. - tree = self.execute_checkout_with_status(cloned_repo_dir, - self.checkout_args) - req_status = tree[self._external_path('simp_req')] - self._check_sync_clean(req_status, - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - self.assertEqual(req_status.source_type, ExternalStatus.MANAGED) - - opt_status = tree[self._external_path('simp_opt')] - self._check_sync_clean(opt_status, - ExternalStatus.EMPTY, - ExternalStatus.DEFAULT) - self.assertEqual(opt_status.source_type, ExternalStatus.OPTIONAL) - - # after checking out optionals, the optional external is also clean. - tree = self.execute_checkout_with_status(cloned_repo_dir, - self.optional_args) - req_status = tree[self._external_path('simp_req')] - self._check_sync_clean(req_status, - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - self.assertEqual(req_status.source_type, ExternalStatus.MANAGED) - - opt_status = tree[self._external_path('simp_opt')] - self._check_sync_clean(opt_status, - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - self.assertEqual(opt_status.source_type, ExternalStatus.OPTIONAL) - - def test_container_simple_verbose(self): - """Verify that verbose status matches non-verbose. - """ - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - self._generator.create_config() - self._generator.create_section(SIMPLE_REPO, TAG_SECTION, - tag='tag1') - self._generator.write_config(cloned_repo_dir) - - # after checkout, all externals should be 'clean'. - tree = self.execute_checkout_with_status(cloned_repo_dir, - self.checkout_args) - self._check_sync_clean(tree[self._external_path(TAG_SECTION)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - # 'Verbose' status should tell the same story. - tree = self.execute_checkout_in_dir(cloned_repo_dir, - self.verbose_args) - self._check_sync_clean(tree[self._external_path(TAG_SECTION)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - def test_container_simple_dirty(self): - """Verify that a container with a new tracked file is marked dirty. - """ - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - self._generator.create_config() - self._generator.create_section(SIMPLE_REPO, TAG_SECTION, - tag='tag1') - self._generator.write_config(cloned_repo_dir) - - # checkout, should start out clean. - tree = self.execute_checkout_with_status(cloned_repo_dir, self.checkout_args) - self._check_sync_clean(tree[self._external_path(TAG_SECTION)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - # add a tracked file to the simp_tag external, should be dirty. - RepoUtils.add_file_to_repo(cloned_repo_dir, - 'externals/{0}/tmp.txt'.format(TAG_SECTION), - tracked=True) - tree = self.execute_checkout_in_dir(cloned_repo_dir, self.status_args) - self._check_sync_clean(tree[self._external_path(TAG_SECTION)], - ExternalStatus.STATUS_OK, - ExternalStatus.DIRTY) - - # Re-checkout; simp_tag should still be dirty. - tree = self.execute_checkout_with_status(cloned_repo_dir, - self.checkout_args) - self._check_sync_clean(tree[self._external_path(TAG_SECTION)], - ExternalStatus.STATUS_OK, - ExternalStatus.DIRTY) - - def test_container_simple_untracked(self): - """Verify that a container with simple subrepos and a untracked files - is not considered 'dirty' and will attempt an update. - - """ - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - self._generator.create_config() - self._generator.create_section(SIMPLE_REPO, TAG_SECTION, - tag='tag1') - self._generator.write_config(cloned_repo_dir) - - # checkout, should start out clean. - tree = self.execute_checkout_with_status(cloned_repo_dir, - self.checkout_args) - self._check_sync_clean(tree[self._external_path(TAG_SECTION)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - # add an untracked file to the simp_tag external, should stay clean. - RepoUtils.add_file_to_repo(cloned_repo_dir, - 'externals/{0}/tmp.txt'.format(TAG_SECTION), - tracked=False) - tree = self.execute_checkout_in_dir(cloned_repo_dir, self.status_args) - self._check_sync_clean(tree[self._external_path(TAG_SECTION)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - # After checkout, the external should still be 'clean'. - tree = self.execute_checkout_with_status(cloned_repo_dir, - self.checkout_args) - self._check_sync_clean(tree[self._external_path(TAG_SECTION)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - def test_container_simple_detached_sync(self): - """Verify that a container with simple subrepos generates the correct - out of sync status when making commits from a detached head - state. - - For more info about 'detached head' state: https://www.cloudbees.com/blog/git-detached-head - """ - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - self._generator.create_config() - self._generator.create_section(SIMPLE_REPO, TAG_SECTION, - tag='tag1') - - self._generator.create_section(SIMPLE_REPO, BRANCH_SECTION, - branch=REMOTE_BRANCH_FEATURE2) - - self._generator.create_section(SIMPLE_REPO, 'simp_hash', - ref_hash='60b1cc1a38d63') - - self._generator.write_config(cloned_repo_dir) - - # externals start out 'empty' aka not checked out. - tree = self.execute_checkout_in_dir(cloned_repo_dir, self.status_args) - self._check_sync_clean(tree[self._external_path(TAG_SECTION)], - ExternalStatus.EMPTY, - ExternalStatus.DEFAULT) - self._check_sync_clean(tree[self._external_path(BRANCH_SECTION)], - ExternalStatus.EMPTY, - ExternalStatus.DEFAULT) - self._check_sync_clean(tree[self._external_path(HASH_SECTION)], - ExternalStatus.EMPTY, - ExternalStatus.DEFAULT) - - # checkout - self.execute_checkout_in_dir(cloned_repo_dir, self.checkout_args) - - # Commit on top of the tag and hash (creating the detached head state in those two - # externals' repos) - # The branch commit does not create the detached head state, but here for completeness. - RepoUtils.create_commit(cloned_repo_dir, TAG_SECTION) - RepoUtils.create_commit(cloned_repo_dir, HASH_SECTION) - RepoUtils.create_commit(cloned_repo_dir, BRANCH_SECTION) - - # sync status of all three should be 'modified' (uncommitted changes) - # clean status is 'ok' (matches externals version) - tree = self.execute_checkout_in_dir(cloned_repo_dir, self.status_args) - self._check_sync_clean(tree[self._external_path(TAG_SECTION)], - ExternalStatus.MODEL_MODIFIED, - ExternalStatus.STATUS_OK) - self._check_sync_clean(tree[self._external_path(BRANCH_SECTION)], - ExternalStatus.MODEL_MODIFIED, - ExternalStatus.STATUS_OK) - self._check_sync_clean(tree[self._external_path(HASH_SECTION)], - ExternalStatus.MODEL_MODIFIED, - ExternalStatus.STATUS_OK) - - # after checkout, all externals should be totally clean (no uncommitted changes, - # and matches externals version). - tree = self.execute_checkout_with_status(cloned_repo_dir, self.checkout_args) - self._check_sync_clean(tree[self._external_path(TAG_SECTION)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - self._check_sync_clean(tree[self._external_path(BRANCH_SECTION)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - self._check_sync_clean(tree[self._external_path(HASH_SECTION)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - def test_container_remote_branch(self): - """Verify that a container with remote branch change works - - """ - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - self._generator.create_config() - self._generator.create_section(SIMPLE_REPO, BRANCH_SECTION, - branch=REMOTE_BRANCH_FEATURE2) - self._generator.write_config(cloned_repo_dir) - - # initial checkout - self.execute_checkout_in_dir(cloned_repo_dir, self.checkout_args) - - # update the branch external to point to a different remote with the same branch, - # then simp_branch should be out of sync - self._generator.write_with_git_branch(cloned_repo_dir, - name=BRANCH_SECTION, - branch=REMOTE_BRANCH_FEATURE2, - new_remote_repo_path=SIMPLE_FORK_REPO) - tree = self.execute_checkout_in_dir(cloned_repo_dir, self.status_args) - self._check_sync_clean(tree[self._external_path(BRANCH_SECTION)], - ExternalStatus.MODEL_MODIFIED, - ExternalStatus.STATUS_OK) - - # checkout new externals, now simp_branch should be clean. - tree = self.execute_checkout_with_status(cloned_repo_dir, self.checkout_args) - self._check_sync_clean(tree[self._external_path(BRANCH_SECTION)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - def test_container_remote_tag_same_branch(self): - """Verify that a container with remote tag change works. The new tag - should not be in the original repo, only the new remote - fork. The new tag is automatically fetched because it is on - the branch. - - """ - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - self._generator.create_config() - self._generator.create_section(SIMPLE_REPO, BRANCH_SECTION, - branch=REMOTE_BRANCH_FEATURE2) - self._generator.write_config(cloned_repo_dir) - - # initial checkout - self.execute_checkout_in_dir(cloned_repo_dir, self.checkout_args) - - # update the config file to point to a different remote with - # the new tag replacing the old branch. Tag MUST NOT be in the original - # repo! status of simp_branch should then be out of sync - self._generator.write_with_tag_and_remote_repo(cloned_repo_dir, BRANCH_SECTION, - tag='forked-feature-v1', - new_remote_repo_path=SIMPLE_FORK_REPO) - tree = self.execute_checkout_in_dir(cloned_repo_dir, - self.status_args) - self._check_sync_clean(tree[self._external_path(BRANCH_SECTION)], - ExternalStatus.MODEL_MODIFIED, - ExternalStatus.STATUS_OK) - - # checkout new externals, then should be synced. - tree = self.execute_checkout_with_status(cloned_repo_dir, - self.checkout_args) - self._check_sync_clean(tree[self._external_path(BRANCH_SECTION)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - def test_container_remote_tag_fetch_all(self): - """Verify that a container with remote tag change works. The new tag - should not be in the original repo, only the new remote - fork. It should also not be on a branch that will be fetched, - and therefore not fetched by default with 'git fetch'. It will - only be retrieved by 'git fetch --tags' - """ - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - self._generator.create_config() - self._generator.create_section(SIMPLE_REPO, BRANCH_SECTION, - branch=REMOTE_BRANCH_FEATURE2) - self._generator.write_config(cloned_repo_dir) - - # initial checkout - self.execute_checkout_in_dir(cloned_repo_dir, self.checkout_args) - - # update the config file to point to a different remote with - # the new tag instead of the old branch. Tag MUST NOT be in the original - # repo! status of simp_branch should then be out of sync. - self._generator.write_with_tag_and_remote_repo(cloned_repo_dir, BRANCH_SECTION, - tag='abandoned-feature', - new_remote_repo_path=SIMPLE_FORK_REPO) - tree = self.execute_checkout_in_dir(cloned_repo_dir, self.status_args) - self._check_sync_clean(tree[self._external_path(BRANCH_SECTION)], - ExternalStatus.MODEL_MODIFIED, - ExternalStatus.STATUS_OK) - - # checkout new externals, should be clean again. - tree = self.execute_checkout_with_status(cloned_repo_dir, - self.checkout_args) - self._check_sync_clean(tree[self._external_path(BRANCH_SECTION)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - def test_container_preserve_dot(self): - """Verify that after inital checkout, modifying an external git repo - url to '.' and the current branch will leave it unchanged. - - """ - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - self._generator.create_config() - self._generator.create_section(SIMPLE_REPO, BRANCH_SECTION, - branch=REMOTE_BRANCH_FEATURE2) - self._generator.write_config(cloned_repo_dir) - - # initial checkout - self.execute_checkout_in_dir(cloned_repo_dir, self.checkout_args) - - # update the config file to point to a different remote with - # the same branch. - self._generator.write_with_git_branch(cloned_repo_dir, name=BRANCH_SECTION, - branch=REMOTE_BRANCH_FEATURE2, - new_remote_repo_path=SIMPLE_FORK_REPO) - # after checkout, should be clean again. - tree = self.execute_checkout_with_status(cloned_repo_dir, self.checkout_args) - self._check_sync_clean(tree[self._external_path(BRANCH_SECTION)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - # update branch to point to a new branch that only exists in - # the local fork - RepoUtils.create_branch(cloned_repo_dir, external_name=BRANCH_SECTION, - branch='private-feature', with_commit=True) - self._generator.write_with_git_branch(cloned_repo_dir, name=BRANCH_SECTION, - branch='private-feature', - new_remote_repo_path=SIMPLE_LOCAL_ONLY_NAME) - # after checkout, should be clean again. - tree = self.execute_checkout_with_status(cloned_repo_dir, self.checkout_args) - self._check_sync_clean(tree[self._external_path(BRANCH_SECTION)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - def test_container_mixed_subrepo(self): - """Verify container with mixed subrepo. - - The mixed subrepo has a sub-externals file with different - sub-externals on different branches. - - """ - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - - self._generator.create_config() - self._generator.create_section(MIXED_REPO, 'mixed_req', - branch='master', sub_externals=CFG_SUB_NAME) - self._generator.write_config(cloned_repo_dir) - - # The subrepo has a repo_url that uses this environment variable. - # It'll be cleared in tearDown(). - os.environ[MIXED_CONT_EXT_ROOT_ENV_VAR] = self._bare_root - debug_env = MIXED_CONT_EXT_ROOT_ENV_VAR + '=' + self._bare_root - - # inital checkout: all requireds are clean, and optional is empty. - tree = self.execute_checkout_with_status(cloned_repo_dir, - self.checkout_args, - debug_env=debug_env) - mixed_req_path = self._external_path('mixed_req') - self._check_sync_clean(tree[mixed_req_path], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - sub_ext_base_path = "{0}/{1}/{2}".format(EXTERNALS_PATH, 'mixed_req', SUB_EXTERNALS_PATH) - # The already-checked-in subexternals file has a 'simp_branch' section - self._check_sync_clean(tree[self._external_path('simp_branch', base_path=sub_ext_base_path)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - # update the mixed-use external to point to different branch - # status should become out of sync for mixed_req, but sub-externals - # are still in sync - self._generator.write_with_git_branch(cloned_repo_dir, name='mixed_req', - branch='new-feature', - new_remote_repo_path=MIXED_REPO) - tree = self.execute_checkout_in_dir(cloned_repo_dir, self.status_args, - debug_env=debug_env) - self._check_sync_clean(tree[mixed_req_path], - ExternalStatus.MODEL_MODIFIED, - ExternalStatus.STATUS_OK) - self._check_sync_clean(tree[self._external_path('simp_branch', base_path=sub_ext_base_path)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - # run the checkout. Now the mixed use external and its sub-externals should be clean. - tree = self.execute_checkout_with_status(cloned_repo_dir, self.checkout_args, - debug_env=debug_env) - self._check_sync_clean(tree[mixed_req_path], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - self._check_sync_clean(tree[self._external_path('simp_branch', base_path=sub_ext_base_path)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - def test_container_component(self): - """Verify that optional component checkout works - """ - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - - # create the top level externals file - self._generator.create_config() - # Optional external, by tag. - self._generator.create_section(SIMPLE_REPO, 'simp_opt', - tag='tag1', required=False) - - # Required external, by branch. - self._generator.create_section(SIMPLE_REPO, BRANCH_SECTION, - branch=REMOTE_BRANCH_FEATURE2) - - # Required external, by hash. - self._generator.create_section(SIMPLE_REPO, HASH_SECTION, - ref_hash='60b1cc1a38d63') - self._generator.write_config(cloned_repo_dir) - - # inital checkout, first try a nonexistent component argument noref - checkout_args = ['simp_opt', 'noref'] - checkout_args.extend(self.checkout_args) - - with self.assertRaises(RuntimeError): - self.execute_checkout_in_dir(cloned_repo_dir, checkout_args) - - # Now explicitly check out one optional component.. - # Explicitly listed component (opt) should be present, the other two not. - checkout_args = ['simp_opt'] - checkout_args.extend(self.checkout_args) - tree = self.execute_checkout_with_status(cloned_repo_dir, - checkout_args) - self._check_sync_clean(tree[self._external_path('simp_opt')], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - self._check_sync_clean(tree[self._external_path(BRANCH_SECTION)], - ExternalStatus.EMPTY, - ExternalStatus.DEFAULT) - self._check_sync_clean(tree[self._external_path(HASH_SECTION)], - ExternalStatus.EMPTY, - ExternalStatus.DEFAULT) - - # Check out a second component, this one required. - # Explicitly listed component (branch) should be present, the still-unlisted one (tag) not. - checkout_args.append(BRANCH_SECTION) - tree = self.execute_checkout_with_status(cloned_repo_dir, - checkout_args) - self._check_sync_clean(tree[self._external_path('simp_opt')], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - self._check_sync_clean(tree[self._external_path(BRANCH_SECTION)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - self._check_sync_clean(tree[self._external_path(HASH_SECTION)], - ExternalStatus.EMPTY, - ExternalStatus.DEFAULT) - - - def test_container_exclude_component(self): - """Verify that exclude component checkout works - """ - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - self._generator.create_config() - self._generator.create_section(SIMPLE_REPO, TAG_SECTION, - tag='tag1') - - self._generator.create_section(SIMPLE_REPO, BRANCH_SECTION, - branch=REMOTE_BRANCH_FEATURE2) - - self._generator.create_section(SIMPLE_REPO, 'simp_hash', - ref_hash='60b1cc1a38d63') - - self._generator.write_config(cloned_repo_dir) - - # inital checkout should result in all externals being clean except excluded TAG_SECTION. - checkout_args = ['--exclude', TAG_SECTION] - checkout_args.extend(self.checkout_args) - tree = self.execute_checkout_with_status(cloned_repo_dir, checkout_args) - self._check_sync_clean(tree[self._external_path(TAG_SECTION)], - ExternalStatus.EMPTY, - ExternalStatus.DEFAULT) - self._check_sync_clean(tree[self._external_path(BRANCH_SECTION)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - self._check_sync_clean(tree[self._external_path(HASH_SECTION)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - def test_subexternal(self): - """Verify that an externals file can be brought in as a reference. - - """ - cloned_repo_dir = self.clone_test_repo(MIXED_REPO) - - self._generator.create_config() - self._generator.create_section_reference_to_subexternal('mixed_base') - self._generator.write_config(cloned_repo_dir) - - # The subrepo has a repo_url that uses this environment variable. - # It'll be cleared in tearDown(). - os.environ[MIXED_CONT_EXT_ROOT_ENV_VAR] = self._bare_root - debug_env = MIXED_CONT_EXT_ROOT_ENV_VAR + '=' + self._bare_root - - # After checkout, confirm required's are clean and the referenced - # subexternal's contents are also clean. - tree = self.execute_checkout_with_status(cloned_repo_dir, - self.checkout_args, - debug_env=debug_env) - - self._check_sync_clean( - tree[self._external_path(BRANCH_SECTION, base_path=SUB_EXTERNALS_PATH)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - def test_container_sparse(self): - """Verify that 'full' container with simple subrepo - can run a sparse checkout and generate the correct initial status. - - """ - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - - # Create a file to list filenames to checkout. - sparse_filename = 'sparse_checkout' - with open(os.path.join(cloned_repo_dir, sparse_filename), 'w') as sfile: - sfile.write(README_NAME) - - self._generator.create_config() - self._generator.create_section(SIMPLE_REPO, TAG_SECTION, - tag='tag2') - - # Same tag as above, but with a sparse file too. - sparse_relpath = '../../' + sparse_filename - self._generator.create_section(SIMPLE_REPO, 'simp_sparse', - tag='tag2', sparse=sparse_relpath) - - self._generator.write_config(cloned_repo_dir) - - # inital checkout, confirm required's are clean. - tree = self.execute_checkout_with_status(cloned_repo_dir, - self.checkout_args) - self._check_sync_clean(tree[self._external_path(TAG_SECTION)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - self._check_sync_clean(tree[self._external_path('simp_sparse')], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - # Check existence of some files - full set in TAG_SECTION, and sparse set - # in 'simp_sparse'. - subrepo_path = os.path.join('externals', TAG_SECTION) - self._check_file_exists(cloned_repo_dir, - os.path.join(subrepo_path, README_NAME)) - self._check_file_exists(cloned_repo_dir, os.path.join(subrepo_path, - 'simple_subdir', - 'subdir_file.txt')) - subrepo_path = os.path.join('externals', 'simp_sparse') - self._check_file_exists(cloned_repo_dir, - os.path.join(subrepo_path, README_NAME)) - self._check_file_absent(cloned_repo_dir, os.path.join(subrepo_path, - 'simple_subdir', - 'subdir_file.txt')) - - -class TestSysCheckoutSVN(BaseTestSysCheckout): - """Run systems level tests of checkout_externals accessing svn repositories - - SVN tests - these tests use the svn repository interface. Since - they require an active network connection, they are significantly - slower than the git tests. But svn testing is critical. So try to - design the tests to only test svn repository functionality - (checkout, switch) and leave generic testing of functionality like - 'optional' to the fast git tests. - - Example timing as of 2017-11: - - * All other git and unit tests combined take between 4-5 seconds - - * Just checking if svn is available for a single test takes 2 seconds. - - * The single svn test typically takes between 10 and 25 seconds - (depending on the network)! - - NOTE(bja, 2017-11) To enable CI testing we can't use a real remote - repository that restricts access and it seems inappropriate to hit - a random open source repo. For now we are just hitting one of our - own github repos using the github svn server interface. This - should be "good enough" for basic checkout and swich - functionality. But if additional svn functionality is required, a - better solution will be necessary. I think eventually we want to - create a small local svn repository on the fly (doesn't require an - svn server or network connection!) and use it for testing. - - """ - - @staticmethod - def _svn_branch_name(): - return './{0}/svn_branch'.format(EXTERNALS_PATH) - - @staticmethod - def _svn_tag_name(): - return './{0}/svn_tag'.format(EXTERNALS_PATH) - - def _check_tag_branch_svn_tag_clean(self, tree): - self._check_sync_clean(tree[self._external_path(TAG_SECTION)], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - self._check_sync_clean(tree[self._svn_branch_name()], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - self._check_sync_clean(tree[self._svn_tag_name()], - ExternalStatus.STATUS_OK, - ExternalStatus.STATUS_OK) - - @staticmethod - def _have_svn_access(): - """Check if we have svn access so we can enable tests that use svn. - - """ - have_svn = False - cmd = ['svn', 'ls', SVN_TEST_REPO, ] - try: - execute_subprocess(cmd) - have_svn = True - except BaseException: - pass - return have_svn - - def _skip_if_no_svn_access(self): - """Function decorator to disable svn tests when svn isn't available - """ - have_svn = self._have_svn_access() - if not have_svn: - raise unittest.SkipTest("No svn access") - - def test_container_simple_svn(self): - """Verify that a container repo can pull in an svn branch and svn tag. - - """ - self._skip_if_no_svn_access() - # create repo - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - - self._generator.create_config() - # Git repo. - self._generator.create_section(SIMPLE_REPO, TAG_SECTION, tag='tag1') - - # Svn repos. - self._generator.create_svn_external('svn_branch', branch='trunk') - self._generator.create_svn_external('svn_tag', tag='tags/cesm2.0.beta07') - - self._generator.write_config(cloned_repo_dir) - - # checkout, make sure all sections are clean. - tree = self.execute_checkout_with_status(cloned_repo_dir, - self.checkout_args) - self._check_tag_branch_svn_tag_clean(tree) - - # update description file to make the tag into a branch and - # trigger a switch - self._generator.write_with_svn_branch(cloned_repo_dir, 'svn_tag', - 'trunk') - - # checkout, again the results should be clean. - tree = self.execute_checkout_with_status(cloned_repo_dir, - self.checkout_args) - self._check_tag_branch_svn_tag_clean(tree) - - # add an untracked file to the repo - tracked = False - RepoUtils.add_file_to_repo(cloned_repo_dir, - 'externals/svn_branch/tmp.txt', tracked) - - # run a no-op checkout. - self.execute_checkout_in_dir(cloned_repo_dir, self.checkout_args) - - # update description file to make the branch into a tag and - # trigger a modified sync status - self._generator.write_with_svn_branch(cloned_repo_dir, 'svn_tag', - 'tags/cesm2.0.beta07') - - self.execute_checkout_in_dir(cloned_repo_dir,self.checkout_args) - - # verify status is still clean and unmodified, last - # checkout modified the working dir state. - tree = self.execute_checkout_in_dir(cloned_repo_dir, - self.verbose_args) - self._check_tag_branch_svn_tag_clean(tree) - -class TestSubrepoCheckout(BaseTestSysCheckout): - # Need to store information at setUp time for checking - # pylint: disable=too-many-instance-attributes - """Run tests to ensure proper handling of repos with submodules. - - By default, submodules in git repositories are checked out. A git - repository checked out as a submodule is treated as if it was - listed in an external with the same properties as in the source - .gitmodules file. - """ - - def setUp(self): - """Setup for all submodule checkout tests - Create a repo with two submodule repositories. - """ - - # Run the basic setup - super().setUp() - # create test repo - # We need to do this here (rather than have a static repo) because - # git submodules do not allow for variables in .gitmodules files - self._test_repo_name = 'test_repo_with_submodules' - self._bare_branch_name = 'subrepo_branch' - self._config_branch_name = 'subrepo_config_branch' - self._container_extern_name = 'externals_container.cfg' - self._my_test_dir = os.path.join(module_tmp_root_dir, self._test_id) - self._repo_dir = os.path.join(self._my_test_dir, self._test_repo_name) - self._checkout_dir = 'repo_with_submodules' - check_dir = self.clone_test_repo(CONTAINER_REPO, - dest_dir_in=self._repo_dir) - self.assertTrue(self._repo_dir == check_dir) - # Add the submodules - cwd = os.getcwd() - fork_repo_dir = os.path.join(self._bare_root, SIMPLE_FORK_REPO) - simple_repo_dir = os.path.join(self._bare_root, SIMPLE_REPO) - self._simple_ext_fork_name = os.path.splitext(SIMPLE_FORK_REPO)[0] - self._simple_ext_name = os.path.join('sourc', - os.path.splitext(SIMPLE_REPO)[0]) - os.chdir(self._repo_dir) - # Add a branch with a subrepo - cmd = ['git', 'branch', self._bare_branch_name, 'master'] - execute_subprocess(cmd) - cmd = ['git', 'checkout', self._bare_branch_name] - execute_subprocess(cmd) - cmd = ['git', 'submodule', 'add', fork_repo_dir] - execute_subprocess(cmd) - cmd = ['git', 'commit', '-am', "'Added simple-ext-fork as a submodule'"] - execute_subprocess(cmd) - # Save the fork repo hash for comparison - os.chdir(self._simple_ext_fork_name) - self._fork_hash_check = self.get_git_hash() - os.chdir(self._repo_dir) - # Now, create a branch to test from_sbmodule - cmd = ['git', 'branch', - self._config_branch_name, self._bare_branch_name] - execute_subprocess(cmd) - cmd = ['git', 'checkout', self._config_branch_name] - execute_subprocess(cmd) - cmd = ['git', 'submodule', 'add', '--name', SIMPLE_REPO, - simple_repo_dir, self._simple_ext_name] - execute_subprocess(cmd) - # Checkout feature2 - os.chdir(self._simple_ext_name) - cmd = ['git', 'branch', 'feature2', 'origin/feature2'] - execute_subprocess(cmd) - cmd = ['git', 'checkout', 'feature2'] - execute_subprocess(cmd) - # Save the fork repo hash for comparison - self._simple_hash_check = self.get_git_hash() - os.chdir(self._repo_dir) - self.write_externals_config(filename=self._container_extern_name, - dest_dir=self._repo_dir, from_submodule=True) - cmd = ['git', 'add', self._container_extern_name] - execute_subprocess(cmd) - cmd = ['git', 'commit', '-am', "'Added simple-ext as a submodule'"] - execute_subprocess(cmd) - # Reset to master - cmd = ['git', 'checkout', 'master'] - execute_subprocess(cmd) - os.chdir(cwd) - - @staticmethod - def get_git_hash(revision="HEAD"): - """Return the hash for """ - cmd = ['git', 'rev-parse', revision] - git_out = execute_subprocess(cmd, output_to_caller=True) - return git_out.strip() - - def write_externals_config(self, name='', dest_dir=None, - filename=CFG_NAME, - branch_name=None, sub_externals=None, - from_submodule=False): - # pylint: disable=too-many-arguments - """Create a container externals file with only simple externals. - - """ - self._generator.create_config() - - if dest_dir is None: - dest_dir = self._my_test_dir - - if from_submodule: - self._generator.create_section(SIMPLE_FORK_REPO, - self._simple_ext_fork_name, - from_submodule=True) - self._generator.create_section(SIMPLE_REPO, - self._simple_ext_name, - branch='feature3', path='', - from_submodule=False) - else: - if branch_name is None: - branch_name = 'master' - - self._generator.create_section(self._test_repo_name, - self._checkout_dir, - branch=branch_name, - path=name, sub_externals=sub_externals, - repo_path_abs=self._repo_dir) - - self._generator.write_config(dest_dir, filename=filename) - - def idempotence_check(self, checkout_dir): - """Verify that calling checkout_externals and - checkout_externals --status does not cause errors""" - cwd = os.getcwd() - os.chdir(checkout_dir) - self.execute_checkout_in_dir(self._my_test_dir, - self.checkout_args) - self.execute_checkout_in_dir(self._my_test_dir, - self.status_args) - os.chdir(cwd) - - def test_submodule_checkout_bare(self): - """Verify that a git repo with submodule is properly checked out - This test if for where there is no 'externals' keyword in the - parent repo. - Correct behavior is that the submodule is checked out using - normal git submodule behavior. - """ - simple_ext_fork_tag = "(tag1)" - simple_ext_fork_status = " " - self.write_externals_config(branch_name=self._bare_branch_name) - self.execute_checkout_in_dir(self._my_test_dir, - self.checkout_args) - cwd = os.getcwd() - checkout_dir = os.path.join(self._my_test_dir, self._checkout_dir) - fork_file = os.path.join(checkout_dir, - self._simple_ext_fork_name, "readme.txt") - self.assertTrue(os.path.exists(fork_file)) - - submods = git_submodule_status(checkout_dir) - print('checking status of', checkout_dir, ':', submods) - self.assertEqual(len(submods.keys()), 1) - self.assertTrue(self._simple_ext_fork_name in submods) - submod = submods[self._simple_ext_fork_name] - self.assertTrue('hash' in submod) - self.assertEqual(submod['hash'], self._fork_hash_check) - self.assertTrue('status' in submod) - self.assertEqual(submod['status'], simple_ext_fork_status) - self.assertTrue('tag' in submod) - self.assertEqual(submod['tag'], simple_ext_fork_tag) - self.idempotence_check(checkout_dir) - - def test_submodule_checkout_none(self): - """Verify that a git repo with submodule is properly checked out - This test is for when 'externals=None' is in parent repo's - externals cfg file. - Correct behavior is the submodle is not checked out. - """ - self.write_externals_config(branch_name=self._bare_branch_name, - sub_externals="none") - self.execute_checkout_in_dir(self._my_test_dir, - self.checkout_args) - cwd = os.getcwd() - checkout_dir = os.path.join(self._my_test_dir, self._checkout_dir) - fork_file = os.path.join(checkout_dir, - self._simple_ext_fork_name, "readme.txt") - self.assertFalse(os.path.exists(fork_file)) - os.chdir(cwd) - self.idempotence_check(checkout_dir) - - def test_submodule_checkout_config(self): # pylint: disable=too-many-locals - """Verify that a git repo with submodule is properly checked out - This test if for when the 'from_submodule' keyword is used in the - parent repo. - Correct behavior is that the submodule is checked out using - normal git submodule behavior. - """ - tag_check = None # Not checked out as submodule - status_check = "-" # Not checked out as submodule - self.write_externals_config(branch_name=self._config_branch_name, - sub_externals=self._container_extern_name) - self.execute_checkout_in_dir(self._my_test_dir, - self.checkout_args) - cwd = os.getcwd() - checkout_dir = os.path.join(self._my_test_dir, self._checkout_dir) - fork_file = os.path.join(checkout_dir, - self._simple_ext_fork_name, "readme.txt") - self.assertTrue(os.path.exists(fork_file)) - os.chdir(checkout_dir) - # Check submodule status - submods = git_submodule_status(checkout_dir) - self.assertEqual(len(submods.keys()), 2) - self.assertTrue(self._simple_ext_fork_name in submods) - submod = submods[self._simple_ext_fork_name] - self.assertTrue('hash' in submod) - self.assertEqual(submod['hash'], self._fork_hash_check) - self.assertTrue('status' in submod) - self.assertEqual(submod['status'], status_check) - self.assertTrue('tag' in submod) - self.assertEqual(submod['tag'], tag_check) - self.assertTrue(self._simple_ext_name in submods) - submod = submods[self._simple_ext_name] - self.assertTrue('hash' in submod) - self.assertEqual(submod['hash'], self._simple_hash_check) - self.assertTrue('status' in submod) - self.assertEqual(submod['status'], status_check) - self.assertTrue('tag' in submod) - self.assertEqual(submod['tag'], tag_check) - # Check fork repo status - os.chdir(self._simple_ext_fork_name) - self.assertEqual(self.get_git_hash(), self._fork_hash_check) - os.chdir(checkout_dir) - os.chdir(self._simple_ext_name) - hash_check = self.get_git_hash('origin/feature3') - self.assertEqual(self.get_git_hash(), hash_check) - os.chdir(cwd) - self.idempotence_check(checkout_dir) - -class TestSysCheckoutErrors(BaseTestSysCheckout): - """Run systems level tests of error conditions in checkout_externals - - Error conditions - these tests are designed to trigger specific - error conditions and ensure that they are being handled as - runtime errors (and hopefully usefull error messages) instead of - the default internal message that won't mean anything to the - user, e.g. key error, called process error, etc. - - These are not 'expected failures'. They are pass when a - RuntimeError is raised, fail if any other error is raised (or no - error is raised). - - """ - - # NOTE(bja, 2017-11) pylint complains about long method names, but - # it is hard to differentiate tests without making them more - # cryptic. - # pylint: disable=invalid-name - - def test_error_unknown_protocol(self): - """Verify that a runtime error is raised when the user specified repo - protocol is not known. - - """ - # create repo - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - self._generator.create_config() - self._generator.create_section(SIMPLE_REPO, BRANCH_SECTION, - branch=REMOTE_BRANCH_FEATURE2) - self._generator.write_config(cloned_repo_dir) - - # update the config file to point to a different remote with - # the tag instead of branch. Tag MUST NOT be in the original - # repo! - self._generator.write_with_protocol(cloned_repo_dir, BRANCH_SECTION, - 'this-protocol-does-not-exist') - - with self.assertRaises(RuntimeError): - self.execute_checkout_in_dir(cloned_repo_dir, self.checkout_args) - - def test_error_switch_protocol(self): - """Verify that a runtime error is raised when the user switches - protocols, git to svn. - - TODO(bja, 2017-11) This correctly results in an error, but it - isn't a helpful error message. - - """ - # create repo - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - self._generator.create_config() - self._generator.create_section(SIMPLE_REPO, BRANCH_SECTION, - branch=REMOTE_BRANCH_FEATURE2) - self._generator.write_config(cloned_repo_dir) - - # update the config file to point to a different remote with - # the tag instead of branch. Tag MUST NOT be in the original - # repo! - self._generator.write_with_protocol(cloned_repo_dir, BRANCH_SECTION, 'svn') - with self.assertRaises(RuntimeError): - self.execute_checkout_in_dir(cloned_repo_dir, self.checkout_args) - - def test_error_unknown_tag(self): - """Verify that a runtime error is raised when the user specified tag - does not exist. - - """ - # create repo - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - self._generator.create_config() - self._generator.create_section(SIMPLE_REPO, BRANCH_SECTION, - branch=REMOTE_BRANCH_FEATURE2) - self._generator.write_config(cloned_repo_dir) - - # update the config file to point to a different remote with - # the tag instead of branch. Tag MUST NOT be in the original - # repo! - self._generator.write_with_tag_and_remote_repo(cloned_repo_dir, BRANCH_SECTION, - tag='this-tag-does-not-exist', - new_remote_repo_path=SIMPLE_REPO) - - with self.assertRaises(RuntimeError): - self.execute_checkout_in_dir(cloned_repo_dir, self.checkout_args) - - def test_error_overspecify_tag_branch(self): - """Verify that a runtime error is raised when the user specified both - tag and a branch - - """ - # create repo - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - self._generator.create_config() - self._generator.create_section(SIMPLE_REPO, BRANCH_SECTION, - branch=REMOTE_BRANCH_FEATURE2) - self._generator.write_config(cloned_repo_dir) - - # update the config file to point to a different remote with - # the tag instead of branch. Tag MUST NOT be in the original - # repo! - self._generator.write_with_tag_and_remote_repo(cloned_repo_dir, BRANCH_SECTION, - tag='this-tag-does-not-exist', - new_remote_repo_path=SIMPLE_REPO, - remove_branch=False) - - with self.assertRaises(RuntimeError): - self.execute_checkout_in_dir(cloned_repo_dir, self.checkout_args) - - def test_error_underspecify_tag_branch(self): - """Verify that a runtime error is raised when the user specified - neither a tag or a branch - - """ - # create repo - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - self._generator.create_config() - self._generator.create_section(SIMPLE_REPO, BRANCH_SECTION, - branch=REMOTE_BRANCH_FEATURE2) - self._generator.write_config(cloned_repo_dir) - - # update the config file to point to a different remote with - # the tag instead of branch. Tag MUST NOT be in the original - # repo! - self._generator.write_without_branch_tag(cloned_repo_dir, BRANCH_SECTION) - - with self.assertRaises(RuntimeError): - self.execute_checkout_in_dir(cloned_repo_dir, self.checkout_args) - - def test_error_missing_url(self): - """Verify that a runtime error is raised when the user specified - neither a tag or a branch - - """ - # create repo - cloned_repo_dir = self.clone_test_repo(CONTAINER_REPO) - self._generator.create_config() - self._generator.create_section(SIMPLE_REPO, BRANCH_SECTION, - branch=REMOTE_BRANCH_FEATURE2) - self._generator.write_config(cloned_repo_dir) - - # update the config file to point to a different remote with - # the tag instead of branch. Tag MUST NOT be in the original - # repo! - self._generator.write_without_repo_url(cloned_repo_dir, - BRANCH_SECTION) - - with self.assertRaises(RuntimeError): - self.execute_checkout_in_dir(cloned_repo_dir, self.checkout_args) - - -if __name__ == '__main__': - unittest.main() diff --git a/manage_externals/test/test_sys_repository_git.py b/manage_externals/test/test_sys_repository_git.py deleted file mode 100644 index 7e5fb5020d..0000000000 --- a/manage_externals/test/test_sys_repository_git.py +++ /dev/null @@ -1,238 +0,0 @@ -#!/usr/bin/env python3 - -"""Tests of some of the functionality in repository_git.py that actually -interacts with git repositories. - -We're calling these "system" tests because we expect them to be a lot -slower than most of the unit tests. - -""" - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import os -import shutil -import tempfile -import unittest - -from manic.repository_git import GitRepository -from manic.externals_description import ExternalsDescription -from manic.externals_description import ExternalsDescriptionDict -from manic.utils import execute_subprocess - -# NOTE(wjs, 2018-04-09) I find a mix of camel case and underscores to be -# more readable for unit test names, so I'm disabling pylint's naming -# convention check -# pylint: disable=C0103 - -# Allow access to protected members -# pylint: disable=W0212 - - -class GitTestCase(unittest.TestCase): - """Adds some git-specific unit test functionality on top of TestCase""" - - def assertIsHash(self, maybe_hash): - """Assert that the string given by maybe_hash really does look - like a git hash. - """ - - # Ensure it is non-empty - self.assertTrue(maybe_hash, msg="maybe_hash is empty") - - # Ensure it has a single string - self.assertEqual(1, len(maybe_hash.split()), - msg="maybe_hash has multiple strings: {}".format(maybe_hash)) - - # Ensure that the only characters in the string are ones allowed - # in hashes - allowed_chars_set = set('0123456789abcdef') - self.assertTrue(set(maybe_hash) <= allowed_chars_set, - msg="maybe_hash has non-hash characters: {}".format(maybe_hash)) - - -class TestGitTestCase(GitTestCase): - """Tests GitTestCase""" - - def test_assertIsHash_true(self): - """Ensure that assertIsHash passes for something that looks - like a hash""" - self.assertIsHash('abc123') - - def test_assertIsHash_empty(self): - """Ensure that assertIsHash raises an AssertionError for an - empty string""" - with self.assertRaises(AssertionError): - self.assertIsHash('') - - def test_assertIsHash_multipleStrings(self): - """Ensure that assertIsHash raises an AssertionError when - given multiple strings""" - with self.assertRaises(AssertionError): - self.assertIsHash('abc123 def456') - - def test_assertIsHash_badChar(self): - """Ensure that assertIsHash raises an AssertionError when given a - string that has a character that doesn't belong in a hash - """ - with self.assertRaises(AssertionError): - self.assertIsHash('abc123g') - - -class TestGitRepositoryGitCommands(GitTestCase): - """Test some git commands in RepositoryGit - - It's silly that we need to create a repository in order to test - these git commands. Much or all of the git functionality that is - currently in repository_git.py should eventually be moved to a - separate module that is solely responsible for wrapping git - commands; that would allow us to test it independently of this - repository class. - """ - - # ======================================================================== - # Test helper functions - # ======================================================================== - - def setUp(self): - # directory we want to return to after the test system and - # checkout_externals are done cd'ing all over the place. - self._return_dir = os.getcwd() - - self._tmpdir = tempfile.mkdtemp() - os.chdir(self._tmpdir) - - self._name = 'component' - rdata = {ExternalsDescription.PROTOCOL: 'git', - ExternalsDescription.REPO_URL: - '/path/to/local/repo', - ExternalsDescription.TAG: - 'tag1', - } - - data = {self._name: - { - ExternalsDescription.REQUIRED: False, - ExternalsDescription.PATH: 'junk', - ExternalsDescription.EXTERNALS: '', - ExternalsDescription.REPO: rdata, - }, - } - model = ExternalsDescriptionDict(data) - repo = model[self._name][ExternalsDescription.REPO] - self._repo = GitRepository('test', repo) - - def tearDown(self): - # return to our common starting point - os.chdir(self._return_dir) - - shutil.rmtree(self._tmpdir, ignore_errors=True) - - @staticmethod - def make_cwd_git_repo(): - """Turn the current directory into an empty git repository""" - execute_subprocess(['git', 'init']) - - @staticmethod - def add_cwd_git_commit(): - """Add a git commit in the current directory""" - with open('README', 'a') as myfile: - myfile.write('more info') - execute_subprocess(['git', 'add', 'README']) - execute_subprocess(['git', 'commit', '-m', 'my commit message']) - - @staticmethod - def checkout_cwd_git_branch(branchname): - """Checkout a new branch in the current directory""" - execute_subprocess(['git', 'checkout', '-b', branchname]) - - @staticmethod - def make_cwd_git_tag(tagname): - """Make a lightweight tag at the current commit""" - execute_subprocess(['git', 'tag', '-m', 'making a tag', tagname]) - - @staticmethod - def checkout_cwd_ref(refname): - """Checkout the given refname in the current directory""" - execute_subprocess(['git', 'checkout', refname]) - - # ======================================================================== - # Begin actual tests - # ======================================================================== - - def test_currentHash_returnsHash(self): - """Ensure that the _git_current_hash function returns a hash""" - self.make_cwd_git_repo() - self.add_cwd_git_commit() - hash_found, myhash = self._repo._git_current_hash(os.getcwd()) - self.assertTrue(hash_found) - self.assertIsHash(myhash) - - def test_currentHash_outsideGitRepo(self): - """Ensure that the _git_current_hash function returns False when - outside a git repository""" - hash_found, myhash = self._repo._git_current_hash(os.getcwd()) - self.assertFalse(hash_found) - self.assertEqual('', myhash) - - def test_currentBranch_onBranch(self): - """Ensure that the _git_current_branch function returns the name - of the branch""" - self.make_cwd_git_repo() - self.add_cwd_git_commit() - self.checkout_cwd_git_branch('foo') - branch_found, mybranch = self._repo._git_current_branch(os.getcwd()) - self.assertTrue(branch_found) - self.assertEqual('foo', mybranch) - - def test_currentBranch_notOnBranch(self): - """Ensure that the _git_current_branch function returns False - when not on a branch""" - self.make_cwd_git_repo() - self.add_cwd_git_commit() - self.make_cwd_git_tag('mytag') - self.checkout_cwd_ref('mytag') - branch_found, mybranch = self._repo._git_current_branch(os.getcwd()) - self.assertFalse(branch_found) - self.assertEqual('', mybranch) - - def test_currentBranch_outsideGitRepo(self): - """Ensure that the _git_current_branch function returns False - when outside a git repository""" - branch_found, mybranch = self._repo._git_current_branch(os.getcwd()) - self.assertFalse(branch_found) - self.assertEqual('', mybranch) - - def test_currentTag_onTag(self): - """Ensure that the _git_current_tag function returns the name of - the tag""" - self.make_cwd_git_repo() - self.add_cwd_git_commit() - self.make_cwd_git_tag('some_tag') - tag_found, mytag = self._repo._git_current_tag(os.getcwd()) - self.assertTrue(tag_found) - self.assertEqual('some_tag', mytag) - - def test_currentTag_notOnTag(self): - """Ensure tha the _git_current_tag function returns False when - not on a tag""" - self.make_cwd_git_repo() - self.add_cwd_git_commit() - self.make_cwd_git_tag('some_tag') - self.add_cwd_git_commit() - tag_found, mytag = self._repo._git_current_tag(os.getcwd()) - self.assertFalse(tag_found) - self.assertEqual('', mytag) - - def test_currentTag_outsideGitRepo(self): - """Ensure that the _git_current_tag function returns False when - outside a git repository""" - tag_found, mytag = self._repo._git_current_tag(os.getcwd()) - self.assertFalse(tag_found) - self.assertEqual('', mytag) - - -if __name__ == '__main__': - unittest.main() diff --git a/manage_externals/test/test_unit_externals_description.py b/manage_externals/test/test_unit_externals_description.py deleted file mode 100644 index 30e5288499..0000000000 --- a/manage_externals/test/test_unit_externals_description.py +++ /dev/null @@ -1,478 +0,0 @@ -#!/usr/bin/env python3 - -"""Unit test driver for checkout_externals - -Note: this script assume the path to the checkout_externals.py module is -already in the python path. - -""" - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import os -import os.path -import shutil -import unittest - -try: - # python2 - from ConfigParser import SafeConfigParser as config_parser - - def config_string_cleaner(text): - """convert strings into unicode - """ - return text.decode('utf-8') -except ImportError: - # python3 - from configparser import ConfigParser as config_parser - - def config_string_cleaner(text): - """Python3 already uses unicode strings, so just return the string - without modification. - - """ - return text - -from manic.externals_description import DESCRIPTION_SECTION, VERSION_ITEM -from manic.externals_description import ExternalsDescription -from manic.externals_description import ExternalsDescriptionDict -from manic.externals_description import ExternalsDescriptionConfigV1 -from manic.externals_description import get_cfg_schema_version -from manic.externals_description import read_externals_description_file -from manic.externals_description import create_externals_description - -from manic.global_constants import EMPTY_STR - - -class TestCfgSchemaVersion(unittest.TestCase): - """Test that schema identification for the externals description - returns the correct results. - - """ - - def setUp(self): - """Reusable config object - """ - self._config = config_parser() - self._config.add_section('section1') - self._config.set('section1', 'keword', 'value') - - self._config.add_section(DESCRIPTION_SECTION) - - def test_schema_version_valid(self): - """Test that schema identification returns the correct version for a - valid tag. - - """ - version_str = '2.1.3' - self._config.set(DESCRIPTION_SECTION, VERSION_ITEM, version_str) - major, minor, patch = get_cfg_schema_version(self._config) - expected_major = 2 - expected_minor = 1 - expected_patch = 3 - self.assertEqual(expected_major, major) - self.assertEqual(expected_minor, minor) - self.assertEqual(expected_patch, patch) - - def test_schema_section_missing(self): - """Test that an error is returned if the schema section is missing - from the input file. - - """ - self._config.remove_section(DESCRIPTION_SECTION) - with self.assertRaises(RuntimeError): - get_cfg_schema_version(self._config) - - def test_schema_version_missing(self): - """Test that a externals description file without a version raises a - runtime error. - - """ - # Note: the default setup method shouldn't include a version - # keyword, but remove it just to be future proof.... - self._config.remove_option(DESCRIPTION_SECTION, VERSION_ITEM) - with self.assertRaises(RuntimeError): - get_cfg_schema_version(self._config) - - def test_schema_version_not_int(self): - """Test that a externals description file a version that doesn't - decompose to integer major, minor and patch versions raises - runtime error. - - """ - self._config.set(DESCRIPTION_SECTION, VERSION_ITEM, 'unknown') - with self.assertRaises(RuntimeError): - get_cfg_schema_version(self._config) - - -class TestModelDescritionConfigV1(unittest.TestCase): - """Test that parsing config/ini fileproduces a correct dictionary - for the externals description. - - """ - # pylint: disable=R0902 - - def setUp(self): - """Boiler plate construction of string containing xml for multiple components. - """ - self._comp1_name = 'comp1' - self._comp1_path = 'path/to/comp1' - self._comp1_protocol = 'svn' - self._comp1_url = 'https://svn.somewhere.com/path/of/comp1' - self._comp1_tag = 'a_nice_tag_v1' - self._comp1_is_required = 'True' - self._comp1_externals = '' - - self._comp2_name = 'comp2' - self._comp2_path = 'path/to/comp2' - self._comp2_protocol = 'git' - self._comp2_url = '/local/clone/of/comp2' - self._comp2_branch = 'a_very_nice_branch' - self._comp2_is_required = 'False' - self._comp2_externals = 'path/to/comp2.cfg' - - def _setup_comp1(self, config): - """Boiler plate construction of xml string for componet 1 - """ - config.add_section(self._comp1_name) - config.set(self._comp1_name, 'local_path', self._comp1_path) - config.set(self._comp1_name, 'protocol', self._comp1_protocol) - config.set(self._comp1_name, 'repo_url', self._comp1_url) - config.set(self._comp1_name, 'tag', self._comp1_tag) - config.set(self._comp1_name, 'required', self._comp1_is_required) - - def _setup_comp2(self, config): - """Boiler plate construction of xml string for componet 2 - """ - config.add_section(self._comp2_name) - config.set(self._comp2_name, 'local_path', self._comp2_path) - config.set(self._comp2_name, 'protocol', self._comp2_protocol) - config.set(self._comp2_name, 'repo_url', self._comp2_url) - config.set(self._comp2_name, 'branch', self._comp2_branch) - config.set(self._comp2_name, 'required', self._comp2_is_required) - config.set(self._comp2_name, 'externals', self._comp2_externals) - - @staticmethod - def _setup_externals_description(config): - """Add the required exernals description section - """ - - config.add_section(DESCRIPTION_SECTION) - config.set(DESCRIPTION_SECTION, VERSION_ITEM, '1.0.1') - - def _check_comp1(self, model): - """Test that component one was constructed correctly. - """ - self.assertTrue(self._comp1_name in model) - comp1 = model[self._comp1_name] - self.assertEqual(comp1[ExternalsDescription.PATH], self._comp1_path) - self.assertTrue(comp1[ExternalsDescription.REQUIRED]) - repo = comp1[ExternalsDescription.REPO] - self.assertEqual(repo[ExternalsDescription.PROTOCOL], - self._comp1_protocol) - self.assertEqual(repo[ExternalsDescription.REPO_URL], self._comp1_url) - self.assertEqual(repo[ExternalsDescription.TAG], self._comp1_tag) - self.assertEqual(EMPTY_STR, comp1[ExternalsDescription.EXTERNALS]) - - def _check_comp2(self, model): - """Test that component two was constucted correctly. - """ - self.assertTrue(self._comp2_name in model) - comp2 = model[self._comp2_name] - self.assertEqual(comp2[ExternalsDescription.PATH], self._comp2_path) - self.assertFalse(comp2[ExternalsDescription.REQUIRED]) - repo = comp2[ExternalsDescription.REPO] - self.assertEqual(repo[ExternalsDescription.PROTOCOL], - self._comp2_protocol) - self.assertEqual(repo[ExternalsDescription.REPO_URL], self._comp2_url) - self.assertEqual(repo[ExternalsDescription.BRANCH], self._comp2_branch) - self.assertEqual(self._comp2_externals, - comp2[ExternalsDescription.EXTERNALS]) - - def test_one_tag_required(self): - """Test that a component source with a tag is correctly parsed. - """ - config = config_parser() - self._setup_comp1(config) - self._setup_externals_description(config) - model = ExternalsDescriptionConfigV1(config) - print(model) - self._check_comp1(model) - - def test_one_branch_externals(self): - """Test that a component source with a branch is correctly parsed. - """ - config = config_parser() - self._setup_comp2(config) - self._setup_externals_description(config) - model = ExternalsDescriptionConfigV1(config) - print(model) - self._check_comp2(model) - - def test_two_sources(self): - """Test that multiple component sources are correctly parsed. - """ - config = config_parser() - self._setup_comp1(config) - self._setup_comp2(config) - self._setup_externals_description(config) - model = ExternalsDescriptionConfigV1(config) - print(model) - self._check_comp1(model) - self._check_comp2(model) - - def test_cfg_v1_reject_unknown_item(self): - """Test that a v1 description object will reject unknown items - """ - config = config_parser() - self._setup_comp1(config) - self._setup_externals_description(config) - config.set(self._comp1_name, 'junk', 'foobar') - with self.assertRaises(RuntimeError): - ExternalsDescriptionConfigV1(config) - - def test_cfg_v1_reject_v2(self): - """Test that a v1 description object won't try to parse a v2 file. - """ - config = config_parser() - self._setup_comp1(config) - self._setup_externals_description(config) - config.set(DESCRIPTION_SECTION, VERSION_ITEM, '2.0.1') - with self.assertRaises(RuntimeError): - ExternalsDescriptionConfigV1(config) - - def test_cfg_v1_reject_v1_too_new(self): - """Test that a v1 description object won't try to parse a v2 file. - """ - config = config_parser() - self._setup_comp1(config) - self._setup_externals_description(config) - config.set(DESCRIPTION_SECTION, VERSION_ITEM, '1.100.0') - with self.assertRaises(RuntimeError): - ExternalsDescriptionConfigV1(config) - - -class TestReadExternalsDescription(unittest.TestCase): - """Test the application logic of read_externals_description_file - """ - TMP_FAKE_DIR = 'fake' - - def setUp(self): - """Setup directory for tests - """ - if not os.path.exists(self.TMP_FAKE_DIR): - os.makedirs(self.TMP_FAKE_DIR) - - def tearDown(self): - """Cleanup tmp stuff on the file system - """ - if os.path.exists(self.TMP_FAKE_DIR): - shutil.rmtree(self.TMP_FAKE_DIR) - - def test_no_file_error(self): - """Test that a runtime error is raised when the file does not exist - - """ - root_dir = os.getcwd() - filename = 'this-file-should-not-exist' - with self.assertRaises(RuntimeError): - read_externals_description_file(root_dir, filename) - - def test_no_dir_error(self): - """Test that a runtime error is raised when the file does not exist - - """ - root_dir = '/path/to/some/repo' - filename = 'externals.cfg' - with self.assertRaises(RuntimeError): - read_externals_description_file(root_dir, filename) - - def test_no_invalid_error(self): - """Test that a runtime error is raised when the file format is invalid - - """ - root_dir = os.getcwd() - filename = 'externals.cfg' - file_path = os.path.join(root_dir, filename) - file_path = os.path.abspath(file_path) - contents = """ - -invalid file format -""" - with open(file_path, 'w') as fhandle: - fhandle.write(contents) - with self.assertRaises(RuntimeError): - read_externals_description_file(root_dir, filename) - os.remove(file_path) - - -class TestCreateExternalsDescription(unittest.TestCase): - """Test the application logic of creat_externals_description - """ - - def setUp(self): - """Create config object used as basis for all tests - """ - self._config = config_parser() - self._gmconfig = config_parser() - self.setup_config() - - def setup_config(self): - """Boiler plate construction of xml string for componet 1 - """ - # Create a standard externals config with a single external - name = 'test' - self._config.add_section(name) - self._config.set(name, ExternalsDescription.PATH, 'externals') - self._config.set(name, ExternalsDescription.PROTOCOL, 'git') - self._config.set(name, ExternalsDescription.REPO_URL, '/path/to/repo') - self._config.set(name, ExternalsDescription.TAG, 'test_tag') - self._config.set(name, ExternalsDescription.REQUIRED, 'True') - - self._config.add_section(DESCRIPTION_SECTION) - self._config.set(DESCRIPTION_SECTION, VERSION_ITEM, '1.0.0') - - # Create a .gitmodules test - name = 'submodule "gitmodules_test"' - self._gmconfig.add_section(name) - self._gmconfig.set(name, "path", 'externals/test') - self._gmconfig.set(name, "url", '/path/to/repo') - # NOTE(goldy, 2019-03) Should test other possible keywords such as - # fetchRecurseSubmodules, ignore, and shallow - - @staticmethod - def setup_dict_config(): - """Create the full container dictionary with simple and mixed use - externals - - """ - rdatat = {ExternalsDescription.PROTOCOL: 'git', - ExternalsDescription.REPO_URL: 'simple-ext.git', - ExternalsDescription.TAG: 'tag1'} - rdatab = {ExternalsDescription.PROTOCOL: 'git', - ExternalsDescription.REPO_URL: 'simple-ext.git', - ExternalsDescription.BRANCH: 'feature2'} - rdatam = {ExternalsDescription.PROTOCOL: 'git', - ExternalsDescription.REPO_URL: 'mixed-cont-ext.git', - ExternalsDescription.BRANCH: 'master'} - desc = {'simp_tag': {ExternalsDescription.REQUIRED: True, - ExternalsDescription.PATH: 'simp_tag', - ExternalsDescription.EXTERNALS: EMPTY_STR, - ExternalsDescription.REPO: rdatat}, - 'simp_branch' : {ExternalsDescription.REQUIRED: True, - ExternalsDescription.PATH: 'simp_branch', - ExternalsDescription.EXTERNALS: EMPTY_STR, - ExternalsDescription.REPO: rdatab}, - 'simp_opt': {ExternalsDescription.REQUIRED: False, - ExternalsDescription.PATH: 'simp_opt', - ExternalsDescription.EXTERNALS: EMPTY_STR, - ExternalsDescription.REPO: rdatat}, - 'mixed_req': {ExternalsDescription.REQUIRED: True, - ExternalsDescription.PATH: 'mixed_req', - ExternalsDescription.EXTERNALS: 'sub-ext.cfg', - ExternalsDescription.REPO: rdatam}} - - return desc - - def test_cfg_v1_ok(self): - """Test that a correct cfg v1 object is created by create_externals_description - - """ - self._config.set(DESCRIPTION_SECTION, VERSION_ITEM, '1.0.3') - ext = create_externals_description(self._config, model_format='cfg') - self.assertIsInstance(ext, ExternalsDescriptionConfigV1) - - def test_cfg_v1_unknown_version(self): - """Test that a config file with unknown schema version is rejected by - create_externals_description. - - """ - self._config.set(DESCRIPTION_SECTION, VERSION_ITEM, '100.0.3') - with self.assertRaises(RuntimeError): - create_externals_description(self._config, model_format='cfg') - - def test_dict(self): - """Test that a correct cfg v1 object is created by create_externals_description - - """ - rdata = {ExternalsDescription.PROTOCOL: 'git', - ExternalsDescription.REPO_URL: '/path/to/repo', - ExternalsDescription.TAG: 'tagv1', - } - - desc = { - 'test': { - ExternalsDescription.REQUIRED: False, - ExternalsDescription.PATH: '../fake', - ExternalsDescription.EXTERNALS: EMPTY_STR, - ExternalsDescription.REPO: rdata, }, - } - - ext = create_externals_description(desc, model_format='dict') - self.assertIsInstance(ext, ExternalsDescriptionDict) - - def test_cfg_component_dict(self): - """Verify that create_externals_description works with a dictionary - """ - # create the top level externals file - desc = self.setup_dict_config() - # Check external with all repos - external = create_externals_description(desc, model_format='dict') - self.assertIsInstance(external, ExternalsDescriptionDict) - self.assertTrue('simp_tag' in external) - self.assertTrue('simp_branch' in external) - self.assertTrue('simp_opt' in external) - self.assertTrue('mixed_req' in external) - - def test_cfg_exclude_component_dict(self): - """Verify that exclude component checkout works with a dictionary - """ - # create the top level externals file - desc = self.setup_dict_config() - # Test an excluded repo - external = create_externals_description(desc, model_format='dict', - exclude=['simp_tag', - 'simp_opt']) - self.assertIsInstance(external, ExternalsDescriptionDict) - self.assertFalse('simp_tag' in external) - self.assertTrue('simp_branch' in external) - self.assertFalse('simp_opt' in external) - self.assertTrue('mixed_req' in external) - - def test_cfg_opt_component_dict(self): - """Verify that exclude component checkout works with a dictionary - """ - # create the top level externals file - desc = self.setup_dict_config() - # Test an excluded repo - external = create_externals_description(desc, model_format='dict', - components=['simp_tag', - 'simp_opt']) - self.assertIsInstance(external, ExternalsDescriptionDict) - self.assertTrue('simp_tag' in external) - self.assertFalse('simp_branch' in external) - self.assertTrue('simp_opt' in external) - self.assertFalse('mixed_req' in external) - - def test_cfg_unknown_version(self): - """Test that a runtime error is raised when an unknown file version is - received - - """ - self._config.set(DESCRIPTION_SECTION, VERSION_ITEM, '123.456.789') - with self.assertRaises(RuntimeError): - create_externals_description(self._config, model_format='cfg') - - def test_cfg_unknown_format(self): - """Test that a runtime error is raised when an unknown format string is - received - - """ - with self.assertRaises(RuntimeError): - create_externals_description(self._config, model_format='unknown') - - -if __name__ == '__main__': - unittest.main() diff --git a/manage_externals/test/test_unit_externals_status.py b/manage_externals/test/test_unit_externals_status.py deleted file mode 100644 index f019514e9e..0000000000 --- a/manage_externals/test/test_unit_externals_status.py +++ /dev/null @@ -1,299 +0,0 @@ -#!/usr/bin/env python3 - -"""Unit test driver for the manic external status reporting module. - -Note: this script assumes the path to the manic package is already in -the python path. - -""" - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import unittest - -from manic.externals_status import ExternalStatus - - -class TestStatusObject(unittest.TestCase): - """Verify that the Status object behaives as expected. - """ - - def test_exists_empty_all(self): - """If the repository sync-state is empty (doesn't exist), and there is no - clean state, then it is considered not to exist. - - """ - stat = ExternalStatus() - stat.sync_state = ExternalStatus.EMPTY - stat.clean_state = ExternalStatus.DEFAULT - exists = stat.exists() - self.assertFalse(exists) - - stat.clean_state = ExternalStatus.EMPTY - exists = stat.exists() - self.assertFalse(exists) - - stat.clean_state = ExternalStatus.UNKNOWN - exists = stat.exists() - self.assertFalse(exists) - - # this state represtens an internal logic error in how the - # repo status was determined. - stat.clean_state = ExternalStatus.STATUS_OK - exists = stat.exists() - self.assertTrue(exists) - - # this state represtens an internal logic error in how the - # repo status was determined. - stat.clean_state = ExternalStatus.DIRTY - exists = stat.exists() - self.assertTrue(exists) - - def test_exists_default_all(self): - """If the repository sync-state is default, then it is considered to exist - regardless of clean state. - - """ - stat = ExternalStatus() - stat.sync_state = ExternalStatus.DEFAULT - stat.clean_state = ExternalStatus.DEFAULT - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.EMPTY - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.UNKNOWN - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.STATUS_OK - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.DIRTY - exists = stat.exists() - self.assertTrue(exists) - - def test_exists_unknown_all(self): - """If the repository sync-state is unknown, then it is considered to exist - regardless of clean state. - - """ - stat = ExternalStatus() - stat.sync_state = ExternalStatus.UNKNOWN - stat.clean_state = ExternalStatus.DEFAULT - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.EMPTY - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.UNKNOWN - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.STATUS_OK - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.DIRTY - exists = stat.exists() - self.assertTrue(exists) - - def test_exists_modified_all(self): - """If the repository sync-state is modified, then it is considered to exist - regardless of clean state. - - """ - stat = ExternalStatus() - stat.sync_state = ExternalStatus.MODEL_MODIFIED - stat.clean_state = ExternalStatus.DEFAULT - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.EMPTY - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.UNKNOWN - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.STATUS_OK - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.DIRTY - exists = stat.exists() - self.assertTrue(exists) - - def test_exists_ok_all(self): - """If the repository sync-state is ok, then it is considered to exist - regardless of clean state. - - """ - stat = ExternalStatus() - stat.sync_state = ExternalStatus.STATUS_OK - stat.clean_state = ExternalStatus.DEFAULT - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.EMPTY - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.UNKNOWN - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.STATUS_OK - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.DIRTY - exists = stat.exists() - self.assertTrue(exists) - - def test_update_ok_all(self): - """If the repository in-sync is ok, then it is safe to - update only if clean state is ok - - """ - stat = ExternalStatus() - stat.sync_state = ExternalStatus.STATUS_OK - stat.clean_state = ExternalStatus.DEFAULT - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.EMPTY - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.UNKNOWN - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.STATUS_OK - safe_to_update = stat.safe_to_update() - self.assertTrue(safe_to_update) - - stat.clean_state = ExternalStatus.DIRTY - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - def test_update_modified_all(self): - """If the repository in-sync is modified, then it is safe to - update only if clean state is ok - - """ - stat = ExternalStatus() - stat.sync_state = ExternalStatus.MODEL_MODIFIED - stat.clean_state = ExternalStatus.DEFAULT - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.EMPTY - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.UNKNOWN - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.STATUS_OK - safe_to_update = stat.safe_to_update() - self.assertTrue(safe_to_update) - - stat.clean_state = ExternalStatus.DIRTY - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - def test_update_unknown_all(self): - """If the repository in-sync is unknown, then it is not safe to - update, regardless of the clean state. - - """ - stat = ExternalStatus() - stat.sync_state = ExternalStatus.UNKNOWN - stat.clean_state = ExternalStatus.DEFAULT - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.EMPTY - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.UNKNOWN - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.STATUS_OK - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.DIRTY - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - def test_update_default_all(self): - """If the repository in-sync is default, then it is not safe to - update, regardless of the clean state. - - """ - stat = ExternalStatus() - stat.sync_state = ExternalStatus.UNKNOWN - stat.clean_state = ExternalStatus.DEFAULT - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.EMPTY - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.UNKNOWN - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.STATUS_OK - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.DIRTY - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - def test_update_empty_all(self): - """If the repository in-sync is empty, then it is not safe to - update, regardless of the clean state. - - """ - stat = ExternalStatus() - stat.sync_state = ExternalStatus.UNKNOWN - stat.clean_state = ExternalStatus.DEFAULT - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.EMPTY - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.UNKNOWN - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.STATUS_OK - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.DIRTY - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - -if __name__ == '__main__': - unittest.main() diff --git a/manage_externals/test/test_unit_repository.py b/manage_externals/test/test_unit_repository.py deleted file mode 100644 index 1b93861834..0000000000 --- a/manage_externals/test/test_unit_repository.py +++ /dev/null @@ -1,208 +0,0 @@ -#!/usr/bin/env python3 - -"""Unit test driver for checkout_externals - -Note: this script assume the path to the checkout_externals.py module is -already in the python path. - -""" - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import unittest - -from manic.repository_factory import create_repository -from manic.repository_git import GitRepository -from manic.repository_svn import SvnRepository -from manic.repository import Repository -from manic.externals_description import ExternalsDescription -from manic.global_constants import EMPTY_STR - - -class TestCreateRepositoryDict(unittest.TestCase): - """Test the create_repository functionality to ensure it returns the - propper type of repository and errors for unknown repository - types. - - """ - - def setUp(self): - """Common data needed for all tests in this class - """ - self._name = 'test_name' - self._repo = {ExternalsDescription.PROTOCOL: None, - ExternalsDescription.REPO_URL: 'junk_root', - ExternalsDescription.TAG: 'junk_tag', - ExternalsDescription.BRANCH: EMPTY_STR, - ExternalsDescription.HASH: EMPTY_STR, - ExternalsDescription.SPARSE: EMPTY_STR, } - - def test_create_repo_git(self): - """Verify that several possible names for the 'git' protocol - create git repository objects. - - """ - protocols = ['git', 'GIT', 'Git', ] - for protocol in protocols: - self._repo[ExternalsDescription.PROTOCOL] = protocol - repo = create_repository(self._name, self._repo) - self.assertIsInstance(repo, GitRepository) - - def test_create_repo_svn(self): - """Verify that several possible names for the 'svn' protocol - create svn repository objects. - """ - protocols = ['svn', 'SVN', 'Svn', ] - for protocol in protocols: - self._repo[ExternalsDescription.PROTOCOL] = protocol - repo = create_repository(self._name, self._repo) - self.assertIsInstance(repo, SvnRepository) - - def test_create_repo_externals_only(self): - """Verify that an externals only repo returns None. - """ - protocols = ['externals_only', ] - for protocol in protocols: - self._repo[ExternalsDescription.PROTOCOL] = protocol - repo = create_repository(self._name, self._repo) - self.assertEqual(None, repo) - - def test_create_repo_unsupported(self): - """Verify that an unsupported protocol generates a runtime error. - """ - protocols = ['not_a_supported_protocol', ] - for protocol in protocols: - self._repo[ExternalsDescription.PROTOCOL] = protocol - with self.assertRaises(RuntimeError): - create_repository(self._name, self._repo) - - -class TestRepository(unittest.TestCase): - """Test the externals description processing used to create the Repository - base class shared by protocol specific repository classes. - - """ - - def test_tag(self): - """Test creation of a repository object with a tag - """ - name = 'test_repo' - protocol = 'test_protocol' - url = 'test_url' - tag = 'test_tag' - repo_info = {ExternalsDescription.PROTOCOL: protocol, - ExternalsDescription.REPO_URL: url, - ExternalsDescription.TAG: tag, - ExternalsDescription.BRANCH: EMPTY_STR, - ExternalsDescription.HASH: EMPTY_STR, - ExternalsDescription.SPARSE: EMPTY_STR, } - repo = Repository(name, repo_info) - print(repo.__dict__) - self.assertEqual(repo.tag(), tag) - self.assertEqual(repo.url(), url) - - def test_branch(self): - """Test creation of a repository object with a branch - """ - name = 'test_repo' - protocol = 'test_protocol' - url = 'test_url' - branch = 'test_branch' - repo_info = {ExternalsDescription.PROTOCOL: protocol, - ExternalsDescription.REPO_URL: url, - ExternalsDescription.BRANCH: branch, - ExternalsDescription.TAG: EMPTY_STR, - ExternalsDescription.HASH: EMPTY_STR, - ExternalsDescription.SPARSE: EMPTY_STR, } - repo = Repository(name, repo_info) - print(repo.__dict__) - self.assertEqual(repo.branch(), branch) - self.assertEqual(repo.url(), url) - - def test_hash(self): - """Test creation of a repository object with a hash - """ - name = 'test_repo' - protocol = 'test_protocol' - url = 'test_url' - ref = 'deadc0de' - sparse = EMPTY_STR - repo_info = {ExternalsDescription.PROTOCOL: protocol, - ExternalsDescription.REPO_URL: url, - ExternalsDescription.BRANCH: EMPTY_STR, - ExternalsDescription.TAG: EMPTY_STR, - ExternalsDescription.HASH: ref, - ExternalsDescription.SPARSE: sparse, } - repo = Repository(name, repo_info) - print(repo.__dict__) - self.assertEqual(repo.hash(), ref) - self.assertEqual(repo.url(), url) - - def test_tag_branch(self): - """Test creation of a repository object with a tag and branch raises a - runtimer error. - - """ - name = 'test_repo' - protocol = 'test_protocol' - url = 'test_url' - branch = 'test_branch' - tag = 'test_tag' - ref = EMPTY_STR - sparse = EMPTY_STR - repo_info = {ExternalsDescription.PROTOCOL: protocol, - ExternalsDescription.REPO_URL: url, - ExternalsDescription.BRANCH: branch, - ExternalsDescription.TAG: tag, - ExternalsDescription.HASH: ref, - ExternalsDescription.SPARSE: sparse, } - with self.assertRaises(RuntimeError): - Repository(name, repo_info) - - def test_tag_branch_hash(self): - """Test creation of a repository object with a tag, branch and hash raises a - runtimer error. - - """ - name = 'test_repo' - protocol = 'test_protocol' - url = 'test_url' - branch = 'test_branch' - tag = 'test_tag' - ref = 'deadc0de' - sparse = EMPTY_STR - repo_info = {ExternalsDescription.PROTOCOL: protocol, - ExternalsDescription.REPO_URL: url, - ExternalsDescription.BRANCH: branch, - ExternalsDescription.TAG: tag, - ExternalsDescription.HASH: ref, - ExternalsDescription.SPARSE: sparse, } - with self.assertRaises(RuntimeError): - Repository(name, repo_info) - - def test_no_tag_no_branch(self): - """Test creation of a repository object without a tag or branch raises a - runtimer error. - - """ - name = 'test_repo' - protocol = 'test_protocol' - url = 'test_url' - branch = EMPTY_STR - tag = EMPTY_STR - ref = EMPTY_STR - sparse = EMPTY_STR - repo_info = {ExternalsDescription.PROTOCOL: protocol, - ExternalsDescription.REPO_URL: url, - ExternalsDescription.BRANCH: branch, - ExternalsDescription.TAG: tag, - ExternalsDescription.HASH: ref, - ExternalsDescription.SPARSE: sparse, } - with self.assertRaises(RuntimeError): - Repository(name, repo_info) - - -if __name__ == '__main__': - unittest.main() diff --git a/manage_externals/test/test_unit_repository_git.py b/manage_externals/test/test_unit_repository_git.py deleted file mode 100644 index 1c01098acf..0000000000 --- a/manage_externals/test/test_unit_repository_git.py +++ /dev/null @@ -1,811 +0,0 @@ -#!/usr/bin/env python3 - -"""Unit test driver for checkout_externals - -Note: this script assume the path to the checkout_externals.py module is -already in the python path. - -""" -# pylint: disable=too-many-lines,protected-access - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import os -import shutil -import unittest - -from manic.repository_git import GitRepository -from manic.externals_status import ExternalStatus -from manic.externals_description import ExternalsDescription -from manic.externals_description import ExternalsDescriptionDict -from manic.global_constants import EMPTY_STR - -# NOTE(bja, 2017-11) order is important here. origin should be a -# subset of other to trap errors on processing remotes! -GIT_REMOTE_OUTPUT_ORIGIN_UPSTREAM = ''' -upstream /path/to/other/repo (fetch) -upstream /path/to/other/repo (push) -other /path/to/local/repo2 (fetch) -other /path/to/local/repo2 (push) -origin /path/to/local/repo (fetch) -origin /path/to/local/repo (push) -''' - - -class TestGitRepositoryCurrentRef(unittest.TestCase): - """test the current_ref command on a git repository - """ - - def setUp(self): - self._name = 'component' - rdata = {ExternalsDescription.PROTOCOL: 'git', - ExternalsDescription.REPO_URL: - '/path/to/local/repo', - ExternalsDescription.TAG: - 'tag1', - } - - data = {self._name: - { - ExternalsDescription.REQUIRED: False, - ExternalsDescription.PATH: 'junk', - ExternalsDescription.EXTERNALS: EMPTY_STR, - ExternalsDescription.REPO: rdata, - }, - } - - model = ExternalsDescriptionDict(data) - repo = model[self._name][ExternalsDescription.REPO] - self._repo = GitRepository('test', repo) - - # - # mock methods replacing git system calls - # - @staticmethod - def _git_current_branch(branch_found, branch_name): - """Return a function that takes the place of - repo._git_current_branch, which returns the given output.""" - def my_git_current_branch(dirname): - """mock function that can take the place of repo._git_current_branch""" - return branch_found, branch_name - return my_git_current_branch - - @staticmethod - def _git_current_tag(tag_found, tag_name): - """Return a function that takes the place of - repo._git_current_tag, which returns the given output.""" - def my_git_current_tag(dirname): - """mock function that can take the place of repo._git_current_tag""" - return tag_found, tag_name - return my_git_current_tag - - @staticmethod - def _git_current_hash(hash_found, hash_name): - """Return a function that takes the place of - repo._git_current_hash, which returns the given output.""" - def my_git_current_hash(dirname): - """mock function that can take the place of repo._git_current_hash""" - return hash_found, hash_name - return my_git_current_hash - - # ------------------------------------------------------------------------ - # Begin tests - # ------------------------------------------------------------------------ - - def test_ref_branch(self): - """Test that we correctly identify we are on a branch - """ - self._repo._git_current_branch = self._git_current_branch( - True, 'feature3') - self._repo._git_current_tag = self._git_current_tag(True, 'foo_tag') - self._repo._git_current_hash = self._git_current_hash(True, 'abc123') - expected = 'foo_tag (branch feature3)' - result = self._repo._current_ref(os.getcwd()) - self.assertEqual(result, expected) - - def test_ref_detached_tag(self): - """Test that we correctly identify that the ref is detached at a tag - """ - self._repo._git_current_branch = self._git_current_branch(False, '') - self._repo._git_current_tag = self._git_current_tag(True, 'foo_tag') - self._repo._git_current_hash = self._git_current_hash(True, 'abc123') - expected = 'foo_tag' - result = self._repo._current_ref(os.getcwd()) - self.assertEqual(result, expected) - - def test_ref_detached_hash(self): - """Test that we can identify ref is detached at a hash - - """ - self._repo._git_current_branch = self._git_current_branch(False, '') - self._repo._git_current_tag = self._git_current_tag(False, '') - self._repo._git_current_hash = self._git_current_hash(True, 'abc123') - expected = 'abc123' - result = self._repo._current_ref(os.getcwd()) - self.assertEqual(result, expected) - - def test_ref_none(self): - """Test that we correctly identify that we're not in a git repo. - """ - self._repo._git_current_branch = self._git_current_branch(False, '') - self._repo._git_current_tag = self._git_current_tag(False, '') - self._repo._git_current_hash = self._git_current_hash(False, '') - result = self._repo._current_ref(os.getcwd()) - self.assertEqual(result, EMPTY_STR) - - -class TestGitRepositoryCheckSync(unittest.TestCase): - """Test whether the GitRepository _check_sync_logic functionality is - correct. - - Note: there are a lot of combinations of state: - - - external description - tag, branch - - - working copy - - doesn't exist (not checked out) - - exists, no git info - incorrect protocol, e.g. svn, or tarball? - - exists, git info - - as expected: - - different from expected: - - detached tag, - - detached hash, - - detached branch (compare remote and branch), - - tracking branch (compare remote and branch), - - same remote - - different remote - - untracked branch - - Test list: - - doesn't exist - - exists no git info - - - num_external * (working copy expected + num_working copy different) - - total tests = 16 - - """ - - # NOTE(bja, 2017-11) pylint complains about long method names, but - # it is hard to differentiate tests without making them more - # cryptic. Also complains about too many public methods, but it - # doesn't really make sense to break this up. - # pylint: disable=invalid-name,too-many-public-methods - - TMP_FAKE_DIR = 'fake' - TMP_FAKE_GIT_DIR = os.path.join(TMP_FAKE_DIR, '.git') - - def setUp(self): - """Setup reusable git repository object - """ - self._name = 'component' - rdata = {ExternalsDescription.PROTOCOL: 'git', - ExternalsDescription.REPO_URL: - '/path/to/local/repo', - ExternalsDescription.TAG: 'tag1', - } - - data = {self._name: - { - ExternalsDescription.REQUIRED: False, - ExternalsDescription.PATH: self.TMP_FAKE_DIR, - ExternalsDescription.EXTERNALS: EMPTY_STR, - ExternalsDescription.REPO: rdata, - }, - } - - model = ExternalsDescriptionDict(data) - repo = model[self._name][ExternalsDescription.REPO] - self._repo = GitRepository('test', repo) - # The unit tests here don't care about the result of - # _current_ref, but we replace it here so that we don't need to - # worry about calling a possibly slow and possibly - # error-producing command (since _current_ref calls various git - # functions): - self._repo._current_ref = self._current_ref_empty - self._create_tmp_git_dir() - - # We have to override this class method rather than the self._repo - # instance method because it is called via - # GitRepository._remote_name_for_url, which is itself a @classmethod - # calls cls._git_remote_verbose(). - self._orignal_git_remote_verbose = GitRepository._git_remote_verbose - GitRepository._git_remote_verbose = self._git_remote_origin_upstream - def tearDown(self): - """Cleanup tmp stuff on the file system - """ - self._remove_tmp_git_dir() - - GitRepository._git_remote_verbose = self._orignal_git_remote_verbose - - def _create_tmp_git_dir(self): - """Create a temporary fake git directory for testing purposes. - """ - if not os.path.exists(self.TMP_FAKE_GIT_DIR): - os.makedirs(self.TMP_FAKE_GIT_DIR) - - def _remove_tmp_git_dir(self): - """Remove the temporary fake git directory - """ - if os.path.exists(self.TMP_FAKE_DIR): - shutil.rmtree(self.TMP_FAKE_DIR) - - # - # mock methods replacing git system calls - # - @staticmethod - def _current_ref_empty(dirname): - """Return an empty string. - - Drop-in for GitRepository._current_ref - """ - return EMPTY_STR - - @staticmethod - def _git_remote_origin_upstream(dirname): - """Return an info string that is a checkout hash. - - Drop-in for GitRepository._git_remote_verbose. - """ - return GIT_REMOTE_OUTPUT_ORIGIN_UPSTREAM - - @staticmethod - def _git_current_hash(myhash): - """Return a function that takes the place of repo._git_current_hash, - which returns the given hash - """ - def my_git_current_hash(dirname): - """mock function that can take the place of repo._git_current_hash""" - return 0, myhash - return my_git_current_hash - - def _git_revparse_commit(self, expected_ref, mystatus, myhash): - """Return a function that takes the place of - repo._git_revparse_commit, which returns a tuple: - (mystatus, myhash). - - Expects the passed-in ref to equal expected_ref - - status = 0 implies success, non-zero implies failure - """ - def my_git_revparse_commit(ref, dirname): - """mock function that can take the place of repo._git_revparse_commit""" - self.assertEqual(expected_ref, ref) - return mystatus, myhash - return my_git_revparse_commit - - # ---------------------------------------------------------------- - # - # Tests where working copy doesn't exist or is invalid - # - # ---------------------------------------------------------------- - def test_sync_dir_not_exist(self): - """Test that a directory that doesn't exist returns an error status - - Note: the Repository classes should be prevented from ever - working on an empty directory by the _Source object. - - """ - stat = ExternalStatus() - self._repo._check_sync(stat, 'invalid_directory_name') - self.assertEqual(stat.sync_state, ExternalStatus.STATUS_ERROR) - # check_dir should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - def test_sync_dir_exist_no_git_info(self): - """Test that a non-existent git repo returns an unknown status - """ - stat = ExternalStatus() - self._repo._tag = 'tag1' - self._repo._git_current_hash = self._git_current_hash('') - self._repo._git_revparse_commit = self._git_revparse_commit( - 'tag1', 1, '') - self._repo._check_sync(stat, self.TMP_FAKE_DIR) - self.assertEqual(stat.sync_state, ExternalStatus.UNKNOWN) - # check_sync should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - # ------------------------------------------------------------------------ - # - # Tests where version in configuration file is not a valid reference - # - # ------------------------------------------------------------------------ - - def test_sync_invalid_reference(self): - """Test that an invalid reference returns out-of-sync - """ - stat = ExternalStatus() - self._repo._tag = 'tag1' - self._repo._git_current_hash = self._git_current_hash('abc123') - self._repo._git_revparse_commit = self._git_revparse_commit( - 'tag1', 1, '') - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - self.assertEqual(stat.sync_state, ExternalStatus.MODEL_MODIFIED) - # check_sync should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - # ---------------------------------------------------------------- - # - # Tests where external description specifies a tag - # - # ---------------------------------------------------------------- - def test_sync_tag_on_same_hash(self): - """Test expect tag on same hash --> status ok - - """ - stat = ExternalStatus() - self._repo._tag = 'tag1' - self._repo._git_current_hash = self._git_current_hash('abc123') - self._repo._git_revparse_commit = self._git_revparse_commit( - 'tag1', 0, 'abc123') - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - self.assertEqual(stat.sync_state, ExternalStatus.STATUS_OK) - # check_sync should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - def test_sync_tag_on_different_hash(self): - """Test expect tag on a different hash --> status modified - - """ - stat = ExternalStatus() - self._repo._tag = 'tag1' - self._repo._git_current_hash = self._git_current_hash('def456') - self._repo._git_revparse_commit = self._git_revparse_commit( - 'tag1', 0, 'abc123') - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - self.assertEqual(stat.sync_state, ExternalStatus.MODEL_MODIFIED) - # check_sync should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - # ---------------------------------------------------------------- - # - # Tests where external description specifies a hash - # - # ---------------------------------------------------------------- - def test_sync_hash_on_same_hash(self): - """Test expect hash on same hash --> status ok - - """ - stat = ExternalStatus() - self._repo._tag = '' - self._repo._hash = 'abc' - self._repo._git_current_hash = self._git_current_hash('abc123') - self._repo._git_revparse_commit = self._git_revparse_commit( - 'abc', 0, 'abc123') - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - self.assertEqual(stat.sync_state, ExternalStatus.STATUS_OK) - # check_sync should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - def test_sync_hash_on_different_hash(self): - """Test expect hash on a different hash --> status modified - - """ - stat = ExternalStatus() - self._repo._tag = '' - self._repo._hash = 'abc' - self._repo._git_current_hash = self._git_current_hash('def456') - self._repo._git_revparse_commit = self._git_revparse_commit( - 'abc', 0, 'abc123') - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - self.assertEqual(stat.sync_state, ExternalStatus.MODEL_MODIFIED) - # check_sync should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - # ---------------------------------------------------------------- - # - # Tests where external description specifies a branch - # - # ---------------------------------------------------------------- - def test_sync_branch_on_same_hash(self): - """Test expect branch on same hash --> status ok - - """ - stat = ExternalStatus() - self._repo._branch = 'feature-2' - self._repo._tag = '' - self._repo._git_current_hash = self._git_current_hash('abc123') - self._repo._git_revparse_commit = ( - self._git_revparse_commit('origin/feature-2', 0, 'abc123')) - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - self.assertEqual(stat.sync_state, ExternalStatus.STATUS_OK) - # check_sync should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - def test_sync_branch_on_diff_hash(self): - """Test expect branch on diff hash --> status modified - - """ - stat = ExternalStatus() - self._repo._branch = 'feature-2' - self._repo._tag = '' - self._repo._git_current_hash = self._git_current_hash('abc123') - self._repo._git_revparse_commit = ( - self._git_revparse_commit('origin/feature-2', 0, 'def456')) - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - self.assertEqual(stat.sync_state, ExternalStatus.MODEL_MODIFIED) - # check_sync should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - def test_sync_branch_diff_remote(self): - """Test _remote_name_for_url with a different remote - - """ - stat = ExternalStatus() - self._repo._branch = 'feature-2' - self._repo._tag = '' - self._repo._url = '/path/to/other/repo' - self._repo._git_current_hash = self._git_current_hash('abc123') - self._repo._git_revparse_commit = ( - self._git_revparse_commit('upstream/feature-2', 0, 'def456')) - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - # The test passes if _git_revparse_commit is called with the - # expected argument - - def test_sync_branch_diff_remote2(self): - """Test _remote_name_for_url with a different remote - - """ - stat = ExternalStatus() - self._repo._branch = 'feature-2' - self._repo._tag = '' - self._repo._url = '/path/to/local/repo2' - self._repo._git_current_hash = self._git_current_hash('abc123') - self._repo._git_revparse_commit = ( - self._git_revparse_commit('other/feature-2', 0, 'def789')) - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - # The test passes if _git_revparse_commit is called with the - # expected argument - - def test_sync_branch_on_unknown_remote(self): - """Test expect branch, but remote is unknown --> status modified - - """ - stat = ExternalStatus() - self._repo._branch = 'feature-2' - self._repo._tag = '' - self._repo._url = '/path/to/unknown/repo' - self._repo._git_current_hash = self._git_current_hash('abc123') - self._repo._git_revparse_commit = ( - self._git_revparse_commit('unknown_remote/feature-2', 1, '')) - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - self.assertEqual(stat.sync_state, ExternalStatus.MODEL_MODIFIED) - # check_sync should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - def test_sync_branch_on_untracked_local(self): - """Test expect branch, on untracked branch in local repo --> status ok - - Setting the externals description to '.' indicates that the - user only wants to consider the current local repo state - without fetching from remotes. This is required to preserve - the current branch of a repository during an update. - - """ - stat = ExternalStatus() - self._repo._branch = 'feature3' - self._repo._tag = '' - self._repo._url = '.' - self._repo._git_current_hash = self._git_current_hash('abc123') - self._repo._git_revparse_commit = ( - self._git_revparse_commit('feature3', 0, 'abc123')) - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - self.assertEqual(stat.sync_state, ExternalStatus.STATUS_OK) - # check_sync should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - -class TestGitStatusPorcelain(unittest.TestCase): - """Test parsing of output from git status --porcelain=v1 -z - """ - # pylint: disable=C0103 - GIT_STATUS_PORCELAIN_V1_ALL = ( - r' D INSTALL\0MM Makefile\0M README.md\0R cmakelists.txt\0' - r'CMakeLists.txt\0D commit-message-template.txt\0A stuff.txt\0' - r'?? junk.txt') - - GIT_STATUS_PORCELAIN_CLEAN = r'' - - def test_porcelain_status_dirty(self): - """Verify that git status output is considered dirty when there are - listed files. - - """ - git_output = self.GIT_STATUS_PORCELAIN_V1_ALL - is_dirty = GitRepository._status_v1z_is_dirty(git_output) - self.assertTrue(is_dirty) - - def test_porcelain_status_clean(self): - """Verify that git status output is considered clean when there are no - listed files. - - """ - git_output = self.GIT_STATUS_PORCELAIN_CLEAN - is_dirty = GitRepository._status_v1z_is_dirty(git_output) - self.assertFalse(is_dirty) - - -class TestGitCreateRemoteName(unittest.TestCase): - """Test the create_remote_name method on the GitRepository class - """ - - def setUp(self): - """Common infrastructure for testing _create_remote_name - """ - self._rdata = {ExternalsDescription.PROTOCOL: 'git', - ExternalsDescription.REPO_URL: - 'empty', - ExternalsDescription.TAG: - 'very_useful_tag', - ExternalsDescription.BRANCH: EMPTY_STR, - ExternalsDescription.HASH: EMPTY_STR, - ExternalsDescription.SPARSE: EMPTY_STR, } - self._repo = GitRepository('test', self._rdata) - - def test_remote_git_proto(self): - """Test remote with git protocol - """ - self._repo._url = 'git@git.github.com:very_nice_org/useful_repo' - remote_name = self._repo._create_remote_name() - self.assertEqual(remote_name, 'very_nice_org_useful_repo') - - def test_remote_https_proto(self): - """Test remote with git protocol - """ - self._repo._url = 'https://www.github.com/very_nice_org/useful_repo' - remote_name = self._repo._create_remote_name() - self.assertEqual(remote_name, 'very_nice_org_useful_repo') - - def test_remote_local_abs(self): - """Test remote with git protocol - """ - self._repo._url = '/path/to/local/repositories/useful_repo' - remote_name = self._repo._create_remote_name() - self.assertEqual(remote_name, 'repositories_useful_repo') - - def test_remote_local_rel(self): - """Test remote with git protocol - """ - os.environ['TEST_VAR'] = '/my/path/to/repos' - self._repo._url = '${TEST_VAR}/../../useful_repo' - remote_name = self._repo._create_remote_name() - self.assertEqual(remote_name, 'path_useful_repo') - del os.environ['TEST_VAR'] - - -class TestVerifyTag(unittest.TestCase): - """Test logic verifying that a tag exists and is unique - - """ - - def setUp(self): - """Setup reusable git repository object - """ - self._name = 'component' - rdata = {ExternalsDescription.PROTOCOL: 'git', - ExternalsDescription.REPO_URL: - '/path/to/local/repo', - ExternalsDescription.TAG: 'tag1', - } - - data = {self._name: - { - ExternalsDescription.REQUIRED: False, - ExternalsDescription.PATH: 'tmp', - ExternalsDescription.EXTERNALS: EMPTY_STR, - ExternalsDescription.REPO: rdata, - }, - } - - model = ExternalsDescriptionDict(data) - repo = model[self._name][ExternalsDescription.REPO] - self._repo = GitRepository('test', repo) - - @staticmethod - def _shell_true(*args, **kwargs): - return 0 - - @staticmethod - def _shell_false(*args, **kwargs): - return 1 - - @staticmethod - def _mock_revparse_commit(ref, dirname): - _ = ref - return (TestValidRef._shell_true, '97ebc0e0deadc0de') - - @staticmethod - def _mock_revparse_commit_false(ref, dirname): - _ = ref - return (TestValidRef._shell_false, '97ebc0e0deadc0de') - - def test_tag_not_tag_branch_commit(self): - """Verify a non-tag returns false - """ - self._repo._git_showref_tag = self._shell_false - self._repo._git_showref_branch = self._shell_false - self._repo._git_lsremote_branch = self._shell_false - self._repo._git_revparse_commit = self._mock_revparse_commit_false - self._repo._tag = 'something' - remote_name = 'origin' - received, _ = self._repo._is_unique_tag(self._repo._tag, remote_name, - os.getcwd()) - self.assertFalse(received) - - def test_tag_not_tag(self): - """Verify a non-tag, untracked remote returns false - """ - self._repo._git_showref_tag = self._shell_false - self._repo._git_showref_branch = self._shell_true - self._repo._git_lsremote_branch = self._shell_true - self._repo._git_revparse_commit = self._mock_revparse_commit_false - self._repo._tag = 'tag1' - remote_name = 'origin' - received, _ = self._repo._is_unique_tag(self._repo._tag, remote_name, - os.getcwd()) - self.assertFalse(received) - - def test_tag_indeterminant(self): - """Verify an indeterminant tag/branch returns false - """ - self._repo._git_showref_tag = self._shell_true - self._repo._git_showref_branch = self._shell_true - self._repo._git_lsremote_branch = self._shell_true - self._repo._git_revparse_commit = self._mock_revparse_commit - self._repo._tag = 'something' - remote_name = 'origin' - received, _ = self._repo._is_unique_tag(self._repo._tag, remote_name, - os.getcwd()) - self.assertFalse(received) - - def test_tag_is_unique(self): - """Verify a unique tag match returns true - """ - self._repo._git_showref_tag = self._shell_true - self._repo._git_showref_branch = self._shell_false - self._repo._git_lsremote_branch = self._shell_false - self._repo._git_revparse_commit = self._mock_revparse_commit - self._repo._tag = 'tag1' - remote_name = 'origin' - received, _ = self._repo._is_unique_tag(self._repo._tag, remote_name, - os.getcwd()) - self.assertTrue(received) - - def test_tag_is_not_hash(self): - """Verify a commit hash is not classified as a tag - """ - self._repo._git_showref_tag = self._shell_false - self._repo._git_showref_branch = self._shell_false - self._repo._git_lsremote_branch = self._shell_false - self._repo._git_revparse_commit = self._mock_revparse_commit - self._repo._tag = '97ebc0e0' - remote_name = 'origin' - received, _ = self._repo._is_unique_tag(self._repo._tag, remote_name, - os.getcwd()) - self.assertFalse(received) - - def test_hash_is_commit(self): - """Verify a commit hash is not classified as a tag - """ - self._repo._git_showref_tag = self._shell_false - self._repo._git_showref_branch = self._shell_false - self._repo._git_lsremote_branch = self._shell_false - self._repo._git_revparse_commit = self._mock_revparse_commit - self._repo._tag = '97ebc0e0' - remote_name = 'origin' - received, _ = self._repo._is_unique_tag(self._repo._tag, remote_name, - os.getcwd()) - self.assertFalse(received) - - -class TestValidRef(unittest.TestCase): - """Test logic verifying that a reference is a valid tag, branch or sha1 - - """ - - def setUp(self): - """Setup reusable git repository object - """ - self._name = 'component' - rdata = {ExternalsDescription.PROTOCOL: 'git', - ExternalsDescription.REPO_URL: - '/path/to/local/repo', - ExternalsDescription.TAG: 'tag1', - } - - data = {self._name: - { - ExternalsDescription.REQUIRED: False, - ExternalsDescription.PATH: 'tmp', - ExternalsDescription.EXTERNALS: EMPTY_STR, - ExternalsDescription.REPO: rdata, - }, - } - - model = ExternalsDescriptionDict(data) - repo = model[self._name][ExternalsDescription.REPO] - self._repo = GitRepository('test', repo) - - @staticmethod - def _shell_true(url, remote=None): - _ = url - _ = remote - return 0 - - @staticmethod - def _shell_false(url, remote=None): - _ = url - _ = remote - return 1 - - @staticmethod - def _mock_revparse_commit_false(ref, dirname): - _ = ref - return (TestValidRef._shell_false, '') - - @staticmethod - def _mock_revparse_commit_true(ref, dirname): - _ = ref - _ = dirname - return (TestValidRef._shell_true, '') - - def test_valid_ref_is_invalid(self): - """Verify an invalid reference raises an exception - """ - self._repo._git_showref_tag = self._shell_false - self._repo._git_showref_branch = self._shell_false - self._repo._git_lsremote_branch = self._shell_false - self._repo._git_revparse_commit = self._mock_revparse_commit_false - self._repo._tag = 'invalid_ref' - with self.assertRaises(RuntimeError): - self._repo._check_for_valid_ref(self._repo._tag, - remote_name=None, - dirname=os.getcwd()) - - def test_valid_tag(self): - """Verify a valid tag return true - """ - self._repo._git_showref_tag = self._shell_true - self._repo._git_showref_branch = self._shell_false - self._repo._git_lsremote_branch = self._shell_false - self._repo._git_revparse_commit = self._mock_revparse_commit_true - self._repo._tag = 'tag1' - received = self._repo._check_for_valid_ref(self._repo._tag, - remote_name=None, - dirname=os.getcwd()) - self.assertTrue(received) - - def test_valid_branch(self): - """Verify a valid tag return true - """ - self._repo._git_showref_tag = self._shell_false - self._repo._git_showref_branch = self._shell_true - self._repo._git_lsremote_branch = self._shell_false - self._repo._git_revparse_commit = self._mock_revparse_commit_true - self._repo._tag = 'tag1' - received = self._repo._check_for_valid_ref(self._repo._tag, - remote_name=None, - dirname=os.getcwd()) - self.assertTrue(received) - - def test_valid_hash(self): - """Verify a valid hash return true - """ - def _mock_revparse_commit_true(ref, dirname): - _ = ref - return (0, '56cc0b539426eb26810af9e') - - self._repo._git_showref_tag = self._shell_false - self._repo._git_showref_branch = self._shell_false - self._repo._git_lsremote_branch = self._shell_false - self._repo._git_revparse_commit = _mock_revparse_commit_true - self._repo._hash = '56cc0b5394' - received = self._repo._check_for_valid_ref(self._repo._hash, - remote_name=None, - dirname=os.getcwd()) - self.assertTrue(received) - - -if __name__ == '__main__': - unittest.main() diff --git a/manage_externals/test/test_unit_repository_svn.py b/manage_externals/test/test_unit_repository_svn.py deleted file mode 100755 index d9309df7f6..0000000000 --- a/manage_externals/test/test_unit_repository_svn.py +++ /dev/null @@ -1,501 +0,0 @@ -#!/usr/bin/env python3 - -"""Unit test driver for checkout_externals - -Note: this script assume the path to the checkout_externals.py module is -already in the python path. - -""" - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import unittest - -from manic.repository_svn import SvnRepository -from manic.externals_status import ExternalStatus -from manic.externals_description import ExternalsDescription -from manic.externals_description import ExternalsDescriptionDict -from manic.global_constants import EMPTY_STR - -# pylint: disable=W0212 - -SVN_INFO_MOSART = """Path: components/mosart -Working Copy Root Path: /Users/andreb/projects/ncar/git-conversion/clm-dev-experimental/components/mosart -URL: https://svn-ccsm-models.cgd.ucar.edu/mosart/trunk_tags/mosart1_0_26 -Relative URL: ^/mosart/trunk_tags/mosart1_0_26 -Repository Root: https://svn-ccsm-models.cgd.ucar.edu -Repository UUID: fe37f545-8307-0410-aea5-b40df96820b5 -Revision: 86711 -Node Kind: directory -Schedule: normal -Last Changed Author: erik -Last Changed Rev: 86031 -Last Changed Date: 2017-07-07 12:28:10 -0600 (Fri, 07 Jul 2017) -""" -SVN_INFO_CISM = """ -Path: components/cism -Working Copy Root Path: /Users/andreb/projects/ncar/git-conversion/clm-dev-experimental/components/cism -URL: https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism2_1_37 -Relative URL: ^/glc/trunk_tags/cism2_1_37 -Repository Root: https://svn-ccsm-models.cgd.ucar.edu -Repository UUID: fe37f545-8307-0410-aea5-b40df96820b5 -Revision: 86711 -Node Kind: directory -Schedule: normal -Last Changed Author: sacks -Last Changed Rev: 85704 -Last Changed Date: 2017-06-15 05:59:28 -0600 (Thu, 15 Jun 2017) -""" - - -class TestSvnRepositoryCheckURL(unittest.TestCase): - """Verify that the svn_check_url function is working as expected. - """ - - def setUp(self): - """Setup reusable svn repository object - """ - self._name = 'component' - rdata = {ExternalsDescription.PROTOCOL: 'svn', - ExternalsDescription.REPO_URL: - 'https://svn-ccsm-models.cgd.ucar.edu', - ExternalsDescription.TAG: - 'mosart/trunk_tags/mosart1_0_26', - } - - data = {self._name: - { - ExternalsDescription.REQUIRED: False, - ExternalsDescription.PATH: 'junk', - ExternalsDescription.EXTERNALS: '', - ExternalsDescription.REPO: rdata, - }, - } - - model = ExternalsDescriptionDict(data) - repo = model[self._name][ExternalsDescription.REPO] - self._repo = SvnRepository('test', repo) - - def test_check_url_same(self): - """Test that we correctly identify that the correct URL. - """ - svn_output = SVN_INFO_MOSART - expected_url = self._repo.url() - result, current_version = \ - self._repo._check_url(svn_output, expected_url) - self.assertEqual(result, ExternalStatus.STATUS_OK) - self.assertEqual(current_version, 'mosart/trunk_tags/mosart1_0_26') - - def test_check_url_different(self): - """Test that we correctly reject an incorrect URL. - """ - svn_output = SVN_INFO_CISM - expected_url = self._repo.url() - result, current_version = \ - self._repo._check_url(svn_output, expected_url) - self.assertEqual(result, ExternalStatus.MODEL_MODIFIED) - self.assertEqual(current_version, 'glc/trunk_tags/cism2_1_37') - - def test_check_url_none(self): - """Test that we can handle an empty string for output, e.g. not an svn - repo. - - """ - svn_output = EMPTY_STR - expected_url = self._repo.url() - result, current_version = \ - self._repo._check_url(svn_output, expected_url) - self.assertEqual(result, ExternalStatus.UNKNOWN) - self.assertEqual(current_version, '') - - -class TestSvnRepositoryCheckSync(unittest.TestCase): - """Test whether the SvnRepository svn_check_sync functionality is - correct. - - """ - - def setUp(self): - """Setup reusable svn repository object - """ - self._name = "component" - rdata = {ExternalsDescription.PROTOCOL: 'svn', - ExternalsDescription.REPO_URL: - 'https://svn-ccsm-models.cgd.ucar.edu/', - ExternalsDescription.TAG: - 'mosart/trunk_tags/mosart1_0_26', - } - - data = {self._name: - { - ExternalsDescription.REQUIRED: False, - ExternalsDescription.PATH: 'junk', - ExternalsDescription.EXTERNALS: EMPTY_STR, - ExternalsDescription.REPO: rdata, - }, - } - - model = ExternalsDescriptionDict(data) - repo = model[self._name][ExternalsDescription.REPO] - self._repo = SvnRepository('test', repo) - - @staticmethod - def _svn_info_empty(*_): - """Return an empty info string. Simulates svn info failing. - """ - return '' - - @staticmethod - def _svn_info_synced(*_): - """Return an info sting that is synced with the setUp data - """ - return SVN_INFO_MOSART - - @staticmethod - def _svn_info_modified(*_): - """Return and info string that is modified from the setUp data - """ - return SVN_INFO_CISM - - def test_repo_dir_not_exist(self): - """Test that a directory that doesn't exist returns an error status - - Note: the Repository classes should be prevented from ever - working on an empty directory by the _Source object. - - """ - stat = ExternalStatus() - self._repo._check_sync(stat, 'junk') - self.assertEqual(stat.sync_state, ExternalStatus.STATUS_ERROR) - # check_dir should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - def test_repo_dir_exist_no_svn_info(self): - """Test that an empty info string returns an unknown status - """ - stat = ExternalStatus() - # Now we over-ride the _svn_info method on the repo to return - # a known value without requiring access to svn. - self._repo._svn_info = self._svn_info_empty - self._repo._check_sync(stat, '.') - self.assertEqual(stat.sync_state, ExternalStatus.UNKNOWN) - # check_dir should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - def test_repo_dir_synced(self): - """Test that a valid info string that is synced to the repo in the - externals description returns an ok status. - - """ - stat = ExternalStatus() - # Now we over-ride the _svn_info method on the repo to return - # a known value without requiring access to svn. - self._repo._svn_info = self._svn_info_synced - self._repo._check_sync(stat, '.') - self.assertEqual(stat.sync_state, ExternalStatus.STATUS_OK) - # check_dir should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - def test_repo_dir_modified(self): - """Test that a valid svn info string that is out of sync with the - externals description returns a modified status. - - """ - stat = ExternalStatus() - # Now we over-ride the _svn_info method on the repo to return - # a known value without requiring access to svn. - self._repo._svn_info = self._svn_info_modified - self._repo._check_sync(stat, '.') - self.assertEqual(stat.sync_state, ExternalStatus.MODEL_MODIFIED) - # check_dir should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - -class TestSVNStatusXML(unittest.TestCase): - """Test parsing of svn status xml output - """ - SVN_STATUS_XML_DIRTY_ALL = ''' - - - - - -sacks -2017-06-15T11:59:00.355419Z - - - - - - -sacks -2013-02-07T16:17:56.412878Z - - - - - - -sacks -2017-05-01T16:48:27.893741Z - - - - - - - - - - - - - - - - -''' - - SVN_STATUS_XML_DIRTY_MISSING = ''' - - - - - -sacks -2017-06-15T11:59:00.355419Z - - - - - - - - -''' - - SVN_STATUS_XML_DIRTY_MODIFIED = ''' - - - - - -sacks -2013-02-07T16:17:56.412878Z - - - - - - - - -''' - - SVN_STATUS_XML_DIRTY_DELETED = ''' - - - - - -sacks -2017-05-01T16:48:27.893741Z - - - - - - - - -''' - - SVN_STATUS_XML_DIRTY_UNVERSION = ''' - - - - - - - - - - - -''' - - SVN_STATUS_XML_DIRTY_ADDED = ''' - - - - - - - - - - - -''' - - SVN_STATUS_XML_CLEAN = ''' - - - - - - - - - - - -''' - - def test_xml_status_dirty_missing(self): - """Verify that svn status output is consindered dirty when there is a - missing file. - - """ - svn_output = self.SVN_STATUS_XML_DIRTY_MISSING - is_dirty = SvnRepository.xml_status_is_dirty( - svn_output) - self.assertTrue(is_dirty) - - def test_xml_status_dirty_modified(self): - """Verify that svn status output is consindered dirty when there is a - modified file. - """ - svn_output = self.SVN_STATUS_XML_DIRTY_MODIFIED - is_dirty = SvnRepository.xml_status_is_dirty( - svn_output) - self.assertTrue(is_dirty) - - def test_xml_status_dirty_deleted(self): - """Verify that svn status output is consindered dirty when there is a - deleted file. - """ - svn_output = self.SVN_STATUS_XML_DIRTY_DELETED - is_dirty = SvnRepository.xml_status_is_dirty( - svn_output) - self.assertTrue(is_dirty) - - def test_xml_status_dirty_unversion(self): - """Verify that svn status output ignores unversioned files when making - the clean/dirty decision. - - """ - svn_output = self.SVN_STATUS_XML_DIRTY_UNVERSION - is_dirty = SvnRepository.xml_status_is_dirty( - svn_output) - self.assertFalse(is_dirty) - - def test_xml_status_dirty_added(self): - """Verify that svn status output is consindered dirty when there is a - added file. - """ - svn_output = self.SVN_STATUS_XML_DIRTY_ADDED - is_dirty = SvnRepository.xml_status_is_dirty( - svn_output) - self.assertTrue(is_dirty) - - def test_xml_status_dirty_all(self): - """Verify that svn status output is consindered dirty when there are - multiple dirty files.. - - """ - svn_output = self.SVN_STATUS_XML_DIRTY_ALL - is_dirty = SvnRepository.xml_status_is_dirty( - svn_output) - self.assertTrue(is_dirty) - - def test_xml_status_dirty_clean(self): - """Verify that svn status output is consindered clean when there are - no 'dirty' files. This means accepting untracked and externals. - - """ - svn_output = self.SVN_STATUS_XML_CLEAN - is_dirty = SvnRepository.xml_status_is_dirty( - svn_output) - self.assertFalse(is_dirty) - - -if __name__ == '__main__': - unittest.main() diff --git a/manage_externals/test/test_unit_utils.py b/manage_externals/test/test_unit_utils.py deleted file mode 100644 index 80e1636649..0000000000 --- a/manage_externals/test/test_unit_utils.py +++ /dev/null @@ -1,350 +0,0 @@ -#!/usr/bin/env python3 - -"""Unit test driver for checkout_externals - -Note: this script assume the path to the checkout_externals.py module is -already in the python path. - -""" - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import os -import unittest - -from manic.utils import last_n_lines, indent_string -from manic.utils import str_to_bool, execute_subprocess -from manic.utils import is_remote_url, split_remote_url, expand_local_url - - -class TestExecuteSubprocess(unittest.TestCase): - """Test the application logic of execute_subprocess wrapper - """ - - def test_exesub_return_stat_err(self): - """Test that execute_subprocess returns a status code when caller - requests and the executed subprocess fails. - - """ - cmd = ['false'] - status = execute_subprocess(cmd, status_to_caller=True) - self.assertEqual(status, 1) - - def test_exesub_return_stat_ok(self): - """Test that execute_subprocess returns a status code when caller - requests and the executed subprocess succeeds. - - """ - cmd = ['true'] - status = execute_subprocess(cmd, status_to_caller=True) - self.assertEqual(status, 0) - - def test_exesub_except_stat_err(self): - """Test that execute_subprocess raises an exception on error when - caller doesn't request return code - - """ - cmd = ['false'] - with self.assertRaises(RuntimeError): - execute_subprocess(cmd, status_to_caller=False) - - -class TestLastNLines(unittest.TestCase): - """Test the last_n_lines function. - - """ - - def test_last_n_lines_short(self): - """With a message with <= n lines, result of last_n_lines should - just be the original message. - - """ - mystr = """three -line -string -""" - - mystr_truncated = last_n_lines( - mystr, 3, truncation_message='[truncated]') - self.assertEqual(mystr, mystr_truncated) - - def test_last_n_lines_long(self): - """With a message with > n lines, result of last_n_lines should - be a truncated string. - - """ - mystr = """a -big -five -line -string -""" - expected = """[truncated] -five -line -string -""" - - mystr_truncated = last_n_lines( - mystr, 3, truncation_message='[truncated]') - self.assertEqual(expected, mystr_truncated) - - -class TestIndentStr(unittest.TestCase): - """Test the indent_string function. - - """ - - def test_indent_string_singleline(self): - """Test the indent_string function with a single-line string - - """ - mystr = 'foo' - result = indent_string(mystr, 4) - expected = ' foo' - self.assertEqual(expected, result) - - def test_indent_string_multiline(self): - """Test the indent_string function with a multi-line string - - """ - mystr = """hello -hi -goodbye -""" - result = indent_string(mystr, 2) - expected = """ hello - hi - goodbye -""" - self.assertEqual(expected, result) - - -class TestStrToBool(unittest.TestCase): - """Test the string to boolean conversion routine. - - """ - - def test_case_insensitive_true(self): - """Verify that case insensitive variants of 'true' returns the True - boolean. - - """ - values = ['true', 'TRUE', 'True', 'tRuE', 't', 'T', ] - for value in values: - received = str_to_bool(value) - self.assertTrue(received) - - def test_case_insensitive_false(self): - """Verify that case insensitive variants of 'false' returns the False - boolean. - - """ - values = ['false', 'FALSE', 'False', 'fAlSe', 'f', 'F', ] - for value in values: - received = str_to_bool(value) - self.assertFalse(received) - - def test_invalid_str_error(self): - """Verify that a non-true/false string generates a runtime error. - """ - values = ['not_true_or_false', 'A', '1', '0', - 'false_is_not_true', 'true_is_not_false'] - for value in values: - with self.assertRaises(RuntimeError): - str_to_bool(value) - - -class TestIsRemoteURL(unittest.TestCase): - """Crude url checking to determine if a url is local or remote. - - """ - - def test_url_remote_git(self): - """verify that a remote git url is identified. - """ - url = 'git@somewhere' - is_remote = is_remote_url(url) - self.assertTrue(is_remote) - - def test_url_remote_ssh(self): - """verify that a remote ssh url is identified. - """ - url = 'ssh://user@somewhere' - is_remote = is_remote_url(url) - self.assertTrue(is_remote) - - def test_url_remote_http(self): - """verify that a remote http url is identified. - """ - url = 'http://somewhere' - is_remote = is_remote_url(url) - self.assertTrue(is_remote) - - def test_url_remote_https(self): - """verify that a remote https url is identified. - """ - url = 'https://somewhere' - is_remote = is_remote_url(url) - self.assertTrue(is_remote) - - def test_url_local_user(self): - """verify that a local path with '~/path/to/repo' gets rejected - - """ - url = '~/path/to/repo' - is_remote = is_remote_url(url) - self.assertFalse(is_remote) - - def test_url_local_var_curly(self): - """verify that a local path with env var '${HOME}' gets rejected - """ - url = '${HOME}/path/to/repo' - is_remote = is_remote_url(url) - self.assertFalse(is_remote) - - def test_url_local_var(self): - """verify that a local path with an env var '$HOME' gets rejected - """ - url = '$HOME/path/to/repo' - is_remote = is_remote_url(url) - self.assertFalse(is_remote) - - def test_url_local_abs(self): - """verify that a local abs path gets rejected - """ - url = '/path/to/repo' - is_remote = is_remote_url(url) - self.assertFalse(is_remote) - - def test_url_local_rel(self): - """verify that a local relative path gets rejected - """ - url = '../../path/to/repo' - is_remote = is_remote_url(url) - self.assertFalse(is_remote) - - -class TestSplitRemoteURL(unittest.TestCase): - """Crude url checking to determine if a url is local or remote. - - """ - - def test_url_remote_git(self): - """verify that a remote git url is identified. - """ - url = 'git@somewhere.com:org/repo' - received = split_remote_url(url) - self.assertEqual(received, "org/repo") - - def test_url_remote_ssh(self): - """verify that a remote ssh url is identified. - """ - url = 'ssh://user@somewhere.com/path/to/repo' - received = split_remote_url(url) - self.assertEqual(received, 'somewhere.com/path/to/repo') - - def test_url_remote_http(self): - """verify that a remote http url is identified. - """ - url = 'http://somewhere.org/path/to/repo' - received = split_remote_url(url) - self.assertEqual(received, 'somewhere.org/path/to/repo') - - def test_url_remote_https(self): - """verify that a remote http url is identified. - """ - url = 'http://somewhere.gov/path/to/repo' - received = split_remote_url(url) - self.assertEqual(received, 'somewhere.gov/path/to/repo') - - def test_url_local_url_unchanged(self): - """verify that a local path is unchanged - - """ - url = '/path/to/repo' - received = split_remote_url(url) - self.assertEqual(received, url) - - -class TestExpandLocalURL(unittest.TestCase): - """Crude url checking to determine if a url is local or remote. - - Remote should be unmodified. - - Local, should perform user and variable expansion. - - """ - - def test_url_local_user1(self): - """verify that a local path with '~/path/to/repo' gets expanded to an - absolute path. - - NOTE(bja, 2017-11) we can't test for something like: - '~user/path/to/repo' because the user has to be in the local - machine password directory and we don't know a user name that - is valid on every system....? - - """ - field = 'test' - url = '~/path/to/repo' - received = expand_local_url(url, field) - print(received) - self.assertTrue(os.path.isabs(received)) - - def test_url_local_expand_curly(self): - """verify that a local path with '${HOME}' gets expanded to an absolute path. - """ - field = 'test' - url = '${HOME}/path/to/repo' - received = expand_local_url(url, field) - self.assertTrue(os.path.isabs(received)) - - def test_url_local_expand_var(self): - """verify that a local path with '$HOME' gets expanded to an absolute path. - """ - field = 'test' - url = '$HOME/path/to/repo' - received = expand_local_url(url, field) - self.assertTrue(os.path.isabs(received)) - - def test_url_local_env_missing(self): - """verify that a local path with env var that is missing gets left as-is - - """ - field = 'test' - url = '$TMP_VAR/path/to/repo' - received = expand_local_url(url, field) - print(received) - self.assertEqual(received, url) - - def test_url_local_expand_env(self): - """verify that a local path with another env var gets expanded to an - absolute path. - - """ - field = 'test' - os.environ['TMP_VAR'] = '/some/absolute' - url = '$TMP_VAR/path/to/repo' - received = expand_local_url(url, field) - del os.environ['TMP_VAR'] - print(received) - self.assertTrue(os.path.isabs(received)) - self.assertEqual(received, '/some/absolute/path/to/repo') - - def test_url_local_normalize_rel(self): - """verify that a local path with another env var gets expanded to an - absolute path. - - """ - field = 'test' - url = '/this/is/a/long/../path/to/a/repo' - received = expand_local_url(url, field) - print(received) - self.assertEqual(received, '/this/is/a/path/to/a/repo') - - -if __name__ == '__main__': - unittest.main() diff --git a/share b/share new file mode 160000 index 0000000000..f6f31fd61c --- /dev/null +++ b/share @@ -0,0 +1 @@ +Subproject commit f6f31fd61cb8f80aee97311fcca64b3e26b0202c diff --git a/src/atmos_phys b/src/atmos_phys new file mode 160000 index 0000000000..f4c09618ea --- /dev/null +++ b/src/atmos_phys @@ -0,0 +1 @@ +Subproject commit f4c09618eaaa19eaf3382f0473a531e20aa9f808 diff --git a/src/chemistry/bulk_aero/aero_model.F90 b/src/chemistry/bulk_aero/aero_model.F90 index c5c25abc74..b285bf710a 100644 --- a/src/chemistry/bulk_aero/aero_model.F90 +++ b/src/chemistry/bulk_aero/aero_model.F90 @@ -33,7 +33,9 @@ module aero_model public :: aero_model_surfarea ! tropospheric aerosol wet surface area for chemistry public :: aero_model_strat_surfarea ! stub - ! Misc private data + public :: wetdep_lq + + ! Misc private data integer :: so4_ndx, cb2_ndx, oc2_ndx, nit_ndx integer :: soa_ndx, soai_ndx, soam_ndx, soab_ndx, soat_ndx, soax_ndx @@ -47,7 +49,7 @@ module aero_model integer :: nwetdep = 0 integer,allocatable :: wetdep_indices(:) logical :: drydep_lq(pcnst) - logical :: wetdep_lq(pcnst) + logical, protected :: wetdep_lq(pcnst) integer :: fracis_idx = 0 @@ -144,7 +146,7 @@ subroutine aero_model_init( pbuf2d ) character(len=20) :: dummy logical :: history_aerosol ! Output MAM or SECT aerosol tendencies logical :: history_dust ! Output dust - + call phys_getopts( history_aerosol_out = history_aerosol,& history_dust_out = history_dust ) @@ -154,7 +156,7 @@ subroutine aero_model_init( pbuf2d ) call seasalt_init() call wetdep_init() - fracis_idx = pbuf_get_index('FRACIS') + fracis_idx = pbuf_get_index('FRACIS') nwetdep = 0 ndrydep = 0 @@ -167,7 +169,7 @@ subroutine aero_model_init( pbuf2d ) ndrydep = ndrydep+1 endif enddo count_species - + if (nwetdep>0) & allocate(wetdep_indices(nwetdep)) if (ndrydep>0) & @@ -192,15 +194,15 @@ subroutine aero_model_init( pbuf2d ) else call endrun(subrname//': invalid wetdep species: '//trim(wetdep_list(m)) ) endif - + if (masterproc) then write(iulog,*) subrname//': '//wetdep_list(m)//' will have wet removal' endif enddo - + ! set flags for drydep tendencies drydep_lq(:) = .false. - do m=1,ndrydep + do m=1,ndrydep id = drydep_indices(m) drydep_lq(id) = .true. enddo @@ -213,61 +215,61 @@ subroutine aero_model_init( pbuf2d ) enddo do m = 1,ndrydep - + dummy = trim(drydep_list(m)) // 'TB' call addfld (dummy,horiz_only, 'A','kg/m2/s',trim(drydep_list(m))//' turbulent dry deposition flux') - if ( history_aerosol ) then + if ( history_aerosol ) then call add_default (dummy, 1, ' ') endif dummy = trim(drydep_list(m)) // 'GV' call addfld (dummy,horiz_only, 'A','kg/m2/s',trim(drydep_list(m)) //' gravitational dry deposition flux') - if ( history_aerosol ) then + if ( history_aerosol ) then call add_default (dummy, 1, ' ') endif dummy = trim(drydep_list(m)) // 'DD' call addfld (dummy,horiz_only, 'A','kg/m2/s',trim(drydep_list(m)) //' dry deposition flux at bottom (grav + turb)') - if ( history_aerosol ) then + if ( history_aerosol ) then call add_default (dummy, 1, ' ') endif dummy = trim(drydep_list(m)) // 'DT' call addfld (dummy,(/ 'lev' /), 'A','kg/kg/s',trim(drydep_list(m))//' dry deposition') - if ( history_aerosol ) then + if ( history_aerosol ) then call add_default (dummy, 1, ' ') endif dummy = trim(drydep_list(m)) // 'DV' call addfld (dummy,(/ 'lev' /), 'A','m/s',trim(drydep_list(m))//' deposition velocity') - if ( history_aerosol ) then + if ( history_aerosol ) then call add_default (dummy, 1, ' ') endif enddo - + if (ndrydep>0) then call inidrydep(rair, gravit) dummy = 'RAM1' call addfld (dummy,horiz_only, 'A','frac','RAM1') - if ( history_aerosol ) then + if ( history_aerosol ) then call add_default (dummy, 1, ' ') endif dummy = 'airFV' call addfld (dummy,horiz_only, 'A','frac','FV') - if ( history_aerosol ) then + if ( history_aerosol ) then call add_default (dummy, 1, ' ') endif if (sslt_active) then dummy = 'SSTSFDRY' call addfld (dummy,horiz_only, 'A','kg/m2/s','Sea salt deposition flux at surface') - if ( history_aerosol ) then + if ( history_aerosol ) then call add_default (dummy, 1, ' ') endif endif if (dust_active) then dummy = 'DSTSFDRY' call addfld (dummy,horiz_only, 'A','kg/m2/s','Dust deposition flux at surface') - if ( history_aerosol ) then + if ( history_aerosol ) then call add_default (dummy, 1, ' ') endif endif @@ -297,24 +299,24 @@ subroutine aero_model_init( pbuf2d ) call addfld (trim(wetdep_list(m))//'SBS', (/ 'lev' /), 'A','kg/kg/s', & trim(wetdep_list(m))//' bs wet deposition') enddo - + if (nwetdep>0) then if (sslt_active) then dummy = 'SSTSFWET' call addfld (dummy,horiz_only, 'A','kg/m2/s','Sea salt wet deposition flux at surface') - if ( history_aerosol ) then + if ( history_aerosol ) then call add_default (dummy, 1, ' ') endif endif if (dust_active) then dummy = 'DSTSFWET' call addfld (dummy,horiz_only, 'A','kg/m2/s','Dust wet deposition flux at surface') - if ( history_aerosol ) then + if ( history_aerosol ) then call add_default (dummy, 1, ' ') endif endif endif - + if (dust_active) then ! emissions diagnostics .... @@ -339,7 +341,7 @@ subroutine aero_model_init( pbuf2d ) endif endif - + if (sslt_active) then dummy = 'SSTSFMBL' @@ -388,9 +390,9 @@ subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, use dust_model, only: dust_depvel, dust_nbin, dust_names use seasalt_model, only: sslt_depvel=>seasalt_depvel, sslt_nbin=>seasalt_nbin, sslt_names=>seasalt_names - ! args + ! args type(physics_state), intent(in) :: state ! Physics state variables - real(r8), intent(in) :: obklen(:) + real(r8), intent(in) :: obklen(:) real(r8), intent(in) :: ustar(:) ! sfc fric vel type(cam_in_t), target, intent(in) :: cam_in ! import state real(r8), intent(in) :: dt ! time step @@ -416,7 +418,7 @@ subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, integer, parameter :: begdst = sslt_nbin+1 integer, parameter :: enddst = sslt_nbin+dust_nbin - integer :: ncol, lchnk + integer :: ncol, lchnk character(len=6) :: aeronames(naero) ! = (/ sslt_names, dust_names /) @@ -436,7 +438,7 @@ subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, real(r8) :: rho(pcols,pver) ! air density in kg/m3 integer :: m,mm, i, im - + if (ndrydep<1) return landfrac => cam_in%landfrac(:) @@ -455,10 +457,10 @@ subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, call outfld( 'airFV', fv(:), pcols, lchnk ) call outfld( 'RAM1', ram1(:), pcols, lchnk ) - + ! note that tendencies are not only in sfc layer (because of sedimentation) ! and that ptend is updated within each subroutine for different species - + call physics_ptend_init(ptend, state%psetcols, 'aero_model_drydep', lq=drydep_lq) aeronames(:sslt_nbin) = sslt_names(:) @@ -499,7 +501,7 @@ subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, if(.true.) then ! use phil's method ! convert from meters/sec to pascals/sec ! pvaeros(:,1) is assumed zero, use density from layer above in conversion - pvaeros(:ncol,2:pverp) = pvaeros(:ncol,2:pverp) * rho(:ncol,:)*gravit + pvaeros(:ncol,2:pverp) = pvaeros(:ncol,2:pverp) * rho(:ncol,:)*gravit ! calculate the tendencies and sfc fluxes from the above velocities call dust_sediment_tend( & @@ -519,7 +521,7 @@ subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, if ( any( dust_names(:)==trim(cnst_name(mm)) ) ) & tsflx_dst(:ncol)=tsflx_dst(:ncol)+sflx(:ncol) - ! if the user has specified prescribed aerosol dep fluxes then + ! if the user has specified prescribed aerosol dep fluxes then ! do not set cam_out dep fluxes according to the prognostic aerosols if (.not. aerodep_flx_prescribed()) then ! set deposition in export state @@ -540,7 +542,7 @@ subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, call outfld( trim(cnst_name(mm))//'DT', ptend%q(:,:,mm), pcols, lchnk) end do - + ! output the total dry deposition if (sslt_active) then call outfld( 'SSTSFDRY', tsflx_slt, pcols, lchnk) @@ -593,7 +595,7 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) real(r8) :: cldv(pcols,pver) ! cloudy volume undergoing scavenging real(r8) :: cldvcu(pcols,pver) ! Convective precipitation area at the top interface of current layer real(r8) :: cldvst(pcols,pver) ! Stratiform precipitation area at the top interface of current layer - + real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble type(wetdep_inputs_t) :: dep_inputs ! obj that contains inputs to wetdepa routine @@ -647,13 +649,13 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) enddo enddo call outfld( trim(cnst_name(mm))//'SFWET', sflx, pcols, lchnk) - + if ( any( sslt_names(:)==trim(cnst_name(mm)) ) ) & sflx_tot_slt(:ncol) = sflx_tot_slt(:ncol) + sflx(:ncol) if ( any( dust_names(:)==trim(cnst_name(mm)) ) ) & sflx_tot_dst(:ncol) = sflx_tot_dst(:ncol) + sflx(:ncol) - ! if the user has specified prescribed aerosol dep fluxes then + ! if the user has specified prescribed aerosol dep fluxes then ! do not set cam_out dep fluxes according to the prognostic aerosols if (.not.aerodep_flx_prescribed()) then ! export deposition fluxes to coupler ??? why "-" sign ??? @@ -673,7 +675,7 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) endif enddo - + if (sslt_active) then call outfld( 'SSTSFWET', sflx_tot_slt, pcols, lchnk) endif @@ -735,7 +737,7 @@ subroutine aero_model_surfarea( & !----------------------------------------------------------------- real(r8), parameter :: rm_sulf = 6.95e-6_r8 ! mean radius of sulfate particles (cm) (Chin) real(r8), parameter :: sd_sulf = 2.03_r8 ! standard deviation of radius for sulfate (Chin) - real(r8), parameter :: rho_sulf = 1.7e3_r8 ! density of sulfate aerosols (kg/m3) (Chin) + real(r8), parameter :: rho_sulf = 1.7e3_r8 ! density of sulfate aerosols (kg/m3) (Chin) real(r8), parameter :: rm_orgc = 2.12e-6_r8 ! mean radius of organic carbon particles (cm) (Chin) real(r8), parameter :: sd_orgc = 2.20_r8 ! standard deviation of radius for OC (Chin) @@ -855,7 +857,7 @@ subroutine aero_model_surfarea( & !------------------------------------------------------------------------- n = v * (6._r8/pi)*(1._r8/(dm_sulf**3._r8))*n_exp !------------------------------------------------------------------------- - ! find surface area of aerosols using dm_wet, log_sd + ! find surface area of aerosols using dm_wet, log_sd ! (increase of sd due to RH is negligible) ! and number density calculated above as distribution ! parameters @@ -867,7 +869,7 @@ subroutine aero_model_surfarea( & else !------------------------------------------------------------------------- ! if so4 not simulated, use off-line sulfate and calculate as above - ! convert sulfate vmr to volume density of aerosol (cm^3_aerosol/cm^3_air) + ! convert sulfate vmr to volume density of aerosol (cm^3_aerosol/cm^3_air) !------------------------------------------------------------------------- v = sulfate(i,k) * m(i,k) * mw_so4 / (avo * rho_sulf) *1.e6_r8 n = v * (6._r8/pi)*(1._r8/(dm_sulf**3._r8))*n_exp @@ -875,7 +877,7 @@ subroutine aero_model_surfarea( & sfc_sulf = n * pi * (dm_sulf_wet**2._r8) * s_exp end if - + !------------------------------------------------------------------------- ! ammonium nitrate (follow same procedure as sulfate, using size and density of sulfate) !------------------------------------------------------------------------- @@ -963,7 +965,7 @@ subroutine aero_model_surfarea( & else sfc_soax = 0._r8 end if - sfc_soa = sfc_soa + sfc_soai + sfc_soam + sfc_soab + sfc_soat + sfc_soax + sfc_soa = sfc_soa + sfc_soai + sfc_soam + sfc_soab + sfc_soat + sfc_soax end if @@ -999,7 +1001,7 @@ subroutine aero_model_strat_surfarea( ncol, mmr, pmid, temp, ltrop, pbuf, strato reff_strat(:,:) = 0._r8 end subroutine aero_model_strat_surfarea - + !============================================================================= !============================================================================= subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, reaction_rates, & @@ -1029,18 +1031,18 @@ subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, reaction_ real(r8), intent(in) :: relhum(:,:) ! relative humidity real(r8), intent(in) :: airdens(:,:) ! total atms density (molec/cm**3) real(r8), intent(in) :: invariants(:,:,:) - real(r8), intent(in) :: del_h2so4_gasprod(:,:) - real(r8), intent(in) :: zm(:,:) - real(r8), intent(in) :: qh2o(:,:) + real(r8), intent(in) :: del_h2so4_gasprod(:,:) + real(r8), intent(in) :: zm(:,:) + real(r8), intent(in) :: qh2o(:,:) real(r8), intent(in) :: cwat(:,:) ! cloud liquid water content (kg/kg) - real(r8), intent(in) :: cldfr(:,:) + real(r8), intent(in) :: cldfr(:,:) real(r8), intent(in) :: cldnum(:,:) ! droplet number concentration (#/kg) real(r8), intent(in) :: vmr0(:,:,:) ! initial mixing ratios (before gas-phase chem changes) real(r8), intent(inout) :: vmr(:,:,:) ! mixing ratios ( vmr ) type(physics_buffer_desc), pointer :: pbuf(:) - - ! local vars + + ! local vars real(r8) :: vmrcw(ncol,pver,gas_pcnst) ! cloud-borne aerosol (vmr) @@ -1070,7 +1072,7 @@ subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, reaction_ invariants, & vmrcw, & vmr, & - xphlwc, & + xphlwc, & aqso4, & aqh2so4, & aqso4_h2o2,& diff --git a/src/chemistry/geoschem/geoschem_src b/src/chemistry/geoschem/geoschem_src new file mode 160000 index 0000000000..28345ee76e --- /dev/null +++ b/src/chemistry/geoschem/geoschem_src @@ -0,0 +1 @@ +Subproject commit 28345ee76e5631d6d14869a36dc73e9dd6e0ce1e diff --git a/src/chemistry/modal_aero/aero_model.F90 b/src/chemistry/modal_aero/aero_model.F90 index 43ef5caa33..d5be58e465 100644 --- a/src/chemistry/modal_aero/aero_model.F90 +++ b/src/chemistry/modal_aero/aero_model.F90 @@ -45,9 +45,10 @@ module aero_model public :: calc_1_impact_rate public :: nimptblgrow_mind, nimptblgrow_maxd + public :: wetdep_lq ! Accessor functions - public :: get_scavimptblvol, get_scavimptblnum, get_dlndg_nimptblgrow + public :: get_scavimptblvol, get_scavimptblnum, get_dlndg_nimptblgrow ! Misc private data @@ -100,7 +101,7 @@ module aero_model integer :: nwetdep = 0 integer,allocatable :: wetdep_indices(:) logical :: drydep_lq(pcnst) - logical :: wetdep_lq(pcnst) + logical, protected :: wetdep_lq(pcnst) logical :: modal_accum_coarse_exch = .false. @@ -525,8 +526,21 @@ subroutine aero_model_init( pbuf2d ) horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, stratiform) at surface') call addfld (trim(cnst_name_cw(n))//'SFSBD', & horiz_only, 'A','kg/m2/s','Wet deposition flux (belowcloud, deep convective) at surface') - end if + call addfld (trim(cnst_name(n))//'WETC', & + (/ 'lev' /), 'A',unit_basename//'/kg/s ','wet deposition tendency') + call addfld (trim(cnst_name(n))//'CONU', & + (/ 'lev' /), 'A',unit_basename//'/kg ','updraft mixing ratio') + + call addfld (trim(cnst_name_cw(n))//'WETC', & + (/ 'lev' /), 'A',unit_basename//'/kg/s ','wet deposition tendency') + call addfld (trim(cnst_name_cw(n))//'CONU', & + (/ 'lev' /), 'A',unit_basename//'/kg ','updraft mixing ratio') + + call addfld( trim(cnst_name_cw(n))//'RSPTD', (/ 'lev' /), 'A', unit_basename//'/kg/s', & + trim(cnst_name_cw(n))//' resuspension tendency') + + end if if ( history_aerosol.or. history_chemistry ) then call add_default( cnst_name_cw(n), 1, ' ' ) @@ -970,8 +984,6 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) use modal_aero_deposition, only: set_srf_wetdep use wetdep, only: wetdepa_v2, wetdep_inputs_set, wetdep_inputs_t use modal_aero_data - use modal_aero_calcsize, only: modal_aero_calcsize_sub - use modal_aero_wateruptake,only: modal_aero_wateruptake_dr use modal_aero_convproc, only: deepconv_wetdep_history, ma_convproc_intr, convproc_do_evaprain_atonce ! args @@ -1076,20 +1088,6 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) call physics_ptend_init(ptend, state%psetcols, 'aero_model_wetdep', lq=wetdep_lq) - ! Do calculations of mode radius and water uptake if: - ! 1) modal aerosols are affecting the climate, or - ! 2) prognostic modal aerosols are enabled - - call t_startf('calcsize') - ! for prognostic modal aerosols the transfer of mass between aitken and accumulation - ! modes is done in conjunction with the dry radius calculation - call modal_aero_calcsize_sub(state, ptend, dt, pbuf) - call t_stopf('calcsize') - - call t_startf('wateruptake') - call modal_aero_wateruptake_dr(state, pbuf) - call t_stopf('wateruptake') - if (nwetdep<1) return call wetdep_inputs_set( state, pbuf, dep_inputs ) @@ -1109,15 +1107,9 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) *state%pdel(:ncol,k)/gravit end do - if(convproc_do_aer) then - qsrflx_mzaer2cnvpr(:,:,:) = 0.0_r8 - aerdepwetis(:,:) = 0.0_r8 - aerdepwetcw(:,:) = 0.0_r8 - else - qsrflx_mzaer2cnvpr(:,:,:) = nan - aerdepwetis(:,:) = nan - aerdepwetcw(:,:) = nan - endif + qsrflx_mzaer2cnvpr(:,:,:) = 0.0_r8 + aerdepwetis(:,:) = 0.0_r8 + aerdepwetcw(:,:) = 0.0_r8 ! calculate the mass-weighted sol_factic for coarse mode species ! sol_factic_coarse(:,:) = 0.30_r8 ! tuned 1/4 @@ -1130,8 +1122,8 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) if ((lcoardust > 0) .and. (lcoarnacl > 0)) then do k = 1, pver do i = 1, ncol - tmpdust = max( 0.0_r8, state%q(i,k,lcoardust) + ptend%q(i,k,lcoardust)*dt ) - tmpnacl = max( 0.0_r8, state%q(i,k,lcoarnacl) + ptend%q(i,k,lcoarnacl)*dt ) + tmpdust = max( 0.0_r8, state%q(i,k,lcoardust) ) + tmpnacl = max( 0.0_r8, state%q(i,k,lcoarnacl) ) if ((tmpdust+tmpnacl) > 1.0e-30_r8) then ! sol_factic_coarse(i,k) = (0.2_r8*tmpdust + 0.4_r8*tmpnacl)/(tmpdust+tmpnacl) ! tuned 1/6 f_act_conv_coarse(i,k) = (f_act_conv_coarse_dust*tmpdust & @@ -1156,6 +1148,35 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) stride_loop = -1 endif + if (convproc_do_aer) then + call t_startf('ma_convproc') + call ma_convproc_intr( state, ptend, pbuf, dt, & + nsrflx_mzaer2cnvpr, qsrflx_mzaer2cnvpr, aerdepwetis, dcondt_resusp3d) + + if (convproc_do_evaprain_atonce) then + do m = 1, ntot_amode ! main loop over aerosol modes + + do lspec = 0, nspec_amode(m) ! loop over number + chem constituents + if (lspec == 0) then ! number + mm = numptrcw_amode(m) + else if (lspec <= nspec_amode(m)) then ! non-water mass + mm = lmassptrcw_amode(lspec,m) + endif + fldcw => qqcw_get_field(pbuf, mm,lchnk) + + call outfld( trim(cnst_name_cw(mm))//'RSPTD', dcondt_resusp3d(mm+pcnst,:ncol,:), ncol, lchnk ) + + do k = 1,pver + do i = 1,ncol + fldcw(i,k) = max(0._r8, fldcw(i,k) + dcondt_resusp3d(mm+pcnst,i,k)*dt) + end do + end do + end do ! loop over number + chem constituents + end do ! m aerosol modes + end if + call t_stopf('ma_convproc') + endif + do m = 1, ntot_amode ! main loop over aerosol modes do lphase = strt_loop,end_loop, stride_loop ! loop over interstitial (1) and cloud-borne (2) forms @@ -1289,7 +1310,7 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) if ((lphase == 1) .and. (lspec <= nspec_amode(m))) then ptend%lq(mm) = .TRUE. dqdt_tmp(:,:) = 0.0_r8 - ! q_tmp reflects changes from modal_aero_calcsize and is the "most current" q + ! q_tmp is the "most current" q q_tmp(1:ncol,:) = state%q(1:ncol,:,mm) + ptend%q(1:ncol,:,mm)*dt if(convproc_do_aer) then !Feed in the saved cloudborne mixing ratios from phase 2 @@ -1326,7 +1347,7 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) endif endif - ptend%q(1:ncol,:,mm) = ptend%q(1:ncol,:,mm) + dqdt_tmp(1:ncol,:) + ptend%q(1:ncol,:,mm) = ptend%q(1:ncol,:,mm) + dqdt_tmp(1:ncol,:) call outfld( trim(cnst_name(mm))//'WET', dqdt_tmp(:,:), pcols, lchnk) call outfld( trim(cnst_name(mm))//'SIC', icscavt, pcols, lchnk) @@ -1341,7 +1362,7 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) enddo enddo if (.not.convproc_do_aer) call outfld( trim(cnst_name(mm))//'SFWET', sflx, pcols, lchnk) - aerdepwetis(:ncol,mm) = sflx(:ncol) + aerdepwetis(:ncol,mm) = aerdepwetis(:ncol,mm) + sflx(:ncol) sflx(:)=0._r8 do k=1,pver @@ -1367,7 +1388,7 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) enddo enddo call outfld( trim(cnst_name(mm))//'SFSBC', sflx, pcols, lchnk) - if (convproc_do_aer)sflxbc = sflx + if (convproc_do_aer) sflxbc = sflx sflx(:)=0._r8 do k=1,pver @@ -1611,42 +1632,6 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) enddo ! lphase = 1, 2 enddo ! m = 1, ntot_amode - if (convproc_do_aer) then - call t_startf('ma_convproc') - call ma_convproc_intr( state, ptend, pbuf, dt, & - nsrflx_mzaer2cnvpr, qsrflx_mzaer2cnvpr, aerdepwetis, & - dcondt_resusp3d) - - if (convproc_do_evaprain_atonce) then - do m = 1, ntot_amode ! main loop over aerosol modes - do lphase = strt_loop,end_loop, stride_loop - ! loop over interstitial (1) and cloud-borne (2) forms - do lspec = 0, nspec_amode(m)+1 ! loop over number + chem constituents + water - if (lspec == 0) then ! number - if (lphase == 1) then - mm = numptr_amode(m) - else - mm = numptrcw_amode(m) - endif - else if (lspec <= nspec_amode(m)) then ! non-water mass - if (lphase == 1) then - mm = lmassptr_amode(lspec,m) - else - mm = lmassptrcw_amode(lspec,m) - endif - endif - if (lphase == 2) then - fldcw => qqcw_get_field(pbuf, mm,lchnk) - fldcw(:ncol,:) = fldcw(:ncol,:) + dcondt_resusp3d(mm,:ncol,:)*dt - end if - end do ! loop over number + chem constituents + water - end do ! lphase - end do ! m aerosol modes - end if - - call t_stopf('ma_convproc') - endif - ! if the user has specified prescribed aerosol dep fluxes then ! do not set cam_out dep fluxes according to the prognostic aerosols if (.not. aerodep_flx_prescribed()) then diff --git a/src/chemistry/modal_aero/modal_aero_convproc.F90 b/src/chemistry/modal_aero/modal_aero_convproc.F90 index 6c8b7cd441..a22f750f21 100644 --- a/src/chemistry/modal_aero/modal_aero_convproc.F90 +++ b/src/chemistry/modal_aero/modal_aero_convproc.F90 @@ -200,7 +200,7 @@ subroutine ma_convproc_init call addfld('DP_WCLDBASE', horiz_only, 'A', 'm/s', & 'Deep conv. cloudbase vertical velocity' ) call addfld('DP_KCLDBASE', horiz_only, 'A', '1', & - 'Deep conv. cloudbase level index' ) + 'Deep conv. cloudbase level index' ) ! output wet deposition fields to history ! I = in-cloud removal; E = precip-evap resuspension @@ -238,12 +238,16 @@ subroutine ma_convproc_init if ( history_aerosol .and. & ( convproc_do_aer .or. convproc_do_gas) ) then - call add_default( 'SH_MFUP_MAX', 1, ' ' ) - call add_default( 'SH_WCLDBASE', 1, ' ' ) - call add_default( 'SH_KCLDBASE', 1, ' ' ) - call add_default( 'DP_MFUP_MAX', 1, ' ' ) - call add_default( 'DP_WCLDBASE', 1, ' ' ) - call add_default( 'DP_KCLDBASE', 1, ' ' ) + if (convproc_do_shallow) then + call add_default( 'SH_MFUP_MAX', 1, ' ' ) + call add_default( 'SH_WCLDBASE', 1, ' ' ) + call add_default( 'SH_KCLDBASE', 1, ' ' ) + end if + if (convproc_do_deep) then + call add_default( 'DP_MFUP_MAX', 1, ' ' ) + call add_default( 'DP_WCLDBASE', 1, ' ' ) + call add_default( 'DP_KCLDBASE', 1, ' ' ) + end if end if fracis_idx = pbuf_get_index('FRACIS') @@ -1097,6 +1101,9 @@ subroutine ma_convproc_tend( & real(r8) zmagl(pver) ! working height above surface (m) real(r8) zkm ! working height above surface (km) + real(r8) :: dcondt2(pcols,pver,pcnst_extd) + real(r8) :: conu2(pcols,pver,pcnst_extd) + character(len=16) :: cnst_name_extd(pcnst_extd) !Fractional area of ensemble mean updrafts in ZM scheme set to 0.01 @@ -1135,6 +1142,9 @@ subroutine ma_convproc_tend( & wup(:) = 0.0_r8 + dcondt2 = 0.0_r8 + conu2 = 0.0_r8 + ! set doconvproc_extd (extended array) values ! inititialize aqfrac to 1.0 for activated aerosol species, 0.0 otherwise doconvproc_extd(:) = .false. @@ -1160,7 +1170,7 @@ subroutine ma_convproc_tend( & if (l <= pcnst) then cnst_name_extd(l) = cnst_name(l) else - cnst_name_extd(l) = trim(cnst_name(l-pcnst)) // '_cw' + cnst_name_extd(l) = cnst_name_cw(l-pcnst) end if end do @@ -1296,6 +1306,10 @@ subroutine ma_convproc_tend( & ! load tracer mixing ratio array, which will be updated at the end of each jtsub interation q_i(1:pver,1:pcnst) = q(icol,1:pver,1:pcnst) + do m = 1,pcnst + conu2(icol,1:pver,m) = q(icol,1:pver,m) + end do + ! ! when method_reduce_actfrac = 2, need to do the updraft calc twice ! (1st to get non-adjusted activation amount, 2nd to apply reduction factor) @@ -1547,6 +1561,8 @@ subroutine ma_convproc_tend( & kactfirst, ipass_calc_updraft ) end if + conu2(icol,k,:) = conu(:,k) + end if ! (convproc_method_activate <= 1) ! aqueous chemistry @@ -1613,6 +1629,7 @@ subroutine ma_convproc_tend( & dconudt_wetdep(m,k) = conu(m,k)*aqfrac(m)*expcdtm1 conu(m,k) = conu(m,k) + dconudt_wetdep(m,k) dconudt_wetdep(m,k) = dconudt_wetdep(m,k) / dt_u(k) + conu2(icol,k,m) = conu(m,k) end if enddo end if @@ -1776,6 +1793,8 @@ subroutine ma_convproc_tend( & dtsub*tmpveca(1:6)/dp_i(k) end if + dcondt2(icol,k,m) = dcondt(m,k) + end if ! "(doconvproc_extd(m))" end do ! "m = 2,ncnst_extd" end do k_loop_main_cc ! "k = ktop, kbot" @@ -2117,6 +2136,24 @@ subroutine ma_convproc_tend( & end do i_loop_main_aa ! of the main "do i = il1g, il2g" loop + do n = 1, ntot_amode + do ll = 0, nspec_amode(n) + if (ll == 0) then + la = numptr_amode(n) + lc = numptrcw_amode(n) + pcnst + else + la = lmassptr_amode(ll,n) + lc = lmassptrcw_amode(ll,n) + pcnst + end if + + call outfld( trim(cnst_name_extd(la))//'WETC', dcondt2(:,:,la), pcols, lchnk ) + call outfld( trim(cnst_name_extd(la))//'CONU', conu2(:,:,la), pcols, lchnk ) + call outfld( trim(cnst_name_extd(lc))//'WETC', dcondt2(:,:,lc), pcols, lchnk ) + call outfld( trim(cnst_name_extd(lc))//'CONU', conu2(:,:,lc), pcols, lchnk ) + + end do + end do + return end subroutine ma_convproc_tend @@ -2216,10 +2253,7 @@ subroutine ma_precpevap_convproc( & ! use -dcondt_wetdep(m,k) as it is negative (or zero) wd_flux(m) = wd_flux(m) + tmpdp*max(0.0_r8, -dcondt_wetdep(m,k)) del_wd_flux_evap = wd_flux(m)*fdel_pr_flux_evap - wd_flux(m) = max( 0.0_r8, wd_flux(m)-del_wd_flux_evap ) - dcondt_prevap(m,k) = del_wd_flux_evap/tmpdp - dcondt(m,k) = dcondt(m,k) + dcondt_prevap(m,k) end if end do @@ -2252,6 +2286,12 @@ subroutine ma_precpevap_convproc( & end if + do m = 2, pcnst_extd + if ( doconvproc_extd(m) ) then + dcondt(m,k) = dcondt(m,k) + dcondt_prevap(m,k) + end if + end do + pr_flux = max( 0.0_r8, pr_flux-del_pr_flux_evap ) if (idiag_prevap > 0) then diff --git a/src/chemistry/mozart/mo_gas_phase_chemdr.F90 b/src/chemistry/mozart/mo_gas_phase_chemdr.F90 index 68657d0739..0575b2f8c0 100644 --- a/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +++ b/src/chemistry/mozart/mo_gas_phase_chemdr.F90 @@ -1072,7 +1072,7 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & do m = 1,pcnst n = map2chm( m ) if ( n > 0 ) then - if (cam_physpkg_is("cam_dev")) then + if (cam_physpkg_is("cam7")) then ! apply to qtend array if (cnst_type(m).eq.'dry') then qtend(:ncol,pver,m) = qtend(:ncol,pver,m) - sflx(:ncol,n)*rpdeldry(:ncol,pver)*gravit diff --git a/src/chemistry/mozart/mo_jshort.F90 b/src/chemistry/mozart/mo_jshort.F90 index aa47dffb31..97ec5f1375 100644 --- a/src/chemistry/mozart/mo_jshort.F90 +++ b/src/chemistry/mozart/mo_jshort.F90 @@ -71,6 +71,9 @@ module mo_jshort real(r8), allocatable :: xs_o3b(:) real(r8), allocatable :: xs_wl(:,:) + real(r8), parameter :: lno2_llimit = 38._r8 ! ln(NO2) lower limit + real(r8), parameter :: lno2_ulimit = 56._r8 ! ln(NO2) upper limit + contains subroutine jshort_init( xs_coef_file, xs_short_file, sht_indexer ) @@ -1492,13 +1495,13 @@ subroutine calc_o2srb( nlev, nid, o2col, tlev, tsrb, xscho2 ) do k = 1,nlev x = log( o2col(k) ) - if( x >= 38._r8 .and. x <= 56._r8 ) then + if( x >= lno2_llimit .and. x <= lno2_ulimit ) then call effxs( x, tlev(k), xs ) xscho2(k,:) = xs(:) - else if( x < 38._r8 ) then + else if( x < lno2_llimit ) then ktop1 = k-1 ktop = min( ktop1,ktop ) - else if( x > 56._r8 ) then + else if( x > lno2_ulimit ) then kbot = k end if end do @@ -1601,9 +1604,9 @@ subroutine effxs( x, t, xs ) ! method: ! ln(xs) = A(X)[T-220]+B(X) ! X = log of slant column of O2 -! A,B calculated from chebyshev polynomial coeffs -! AC and BC using NR routine chebev. Assume interval -! is 38lno2_ulimit) then + call endrun('mo_jshort::calc_params of O2 abs xs: x is not in the valid range. ') + end if + !------------------------------------------------------------- -! ... call chebyshev evaluation routine to calc a and b from -! set of 20 coeficients for each wavelength +! ... evaluate at each wavelength +! for a set of 20 Chebyshev coeficients !------------------------------------------------------------- do i = 1,nsrbtuv - a(i) = jchebev( 38._r8, 56._r8, ac(1,i), 20, x ) - b(i) = jchebev( 38._r8, 56._r8, bc(1,i), 20, x ) + a(i) = evalchebpoly( ac(:,i), x ) + b(i) = evalchebpoly( bc(:,i), x ) end do contains - function jchebev( a, b, c, m, x ) -!------------------------------------------------------------- -! Chebyshev evaluation algorithm -! See Numerical recipes p193 -!------------------------------------------------------------- + ! Use Clenshaw summation algorithm to evaluate Chebyshev polynomial at point + ! [pnt - (lno2_ulimit + lno2_llimit)/2]/[(lno2_ulimit - lno2_llimit)/2] + ! given coefficients coefs within limits lim1 and lim2 + pure function evalchebpoly( coefs, pnt ) result(cval) + real(r8), intent(in) :: coefs(:) + real(r8), intent(in) :: pnt -!------------------------------------------------------------- -! ... Dummy arguments -!------------------------------------------------------------- - integer, intent(in) :: m - real(r8), intent(in) :: a, b, x - real(r8), intent(in) :: c(m) + real(r8) :: cval + real(r8) :: fac(2) + real(r8) :: csum(2) ! Clenshaw summation + integer :: ndx + integer :: ncoef - real(r8) :: jchebev -!------------------------------------------------------------- -! ... Local variables -!------------------------------------------------------------- - integer :: j - real(r8) :: d, dd, sv, y, y2 + ncoef = size(coefs) - if( (x - a)*(x - b) > 0._r8 ) then - write(iulog,*) 'x not in range in chebev', x - jchebev = 0._r8 - return - end if + fac(1) = (2._r8*pnt-lno2_llimit-lno2_ulimit)/(lno2_ulimit-lno2_llimit) + fac(2) = 2._r8*fac(1) - d = 0._r8 - dd = 0._r8 - y = (2._r8*x - a - b)/(b - a) - y2 = 2._r8*y - do j = m,2,-1 - sv = d - d = y2*d - dd + c(j) - dd = sv - end do + ! Clenshaw recurrence summation + csum(:) = 0.0_r8 + do ndx = ncoef, 2, -1 + cval = csum(1) + csum(1) = fac(2)*csum(1) - csum(2) + coefs(ndx) + csum(2) = cval + end do - jchebev = y*d - dd + .5_r8*c(1) + cval = fac(1)*csum(1) - csum(2) + 0.5_r8*coefs(1) - end function jchebev + end function evalchebpoly end subroutine calc_params diff --git a/src/chemistry/mozart/mo_usrrxt.F90 b/src/chemistry/mozart/mo_usrrxt.F90 index 6c6edddaad..f37b45c92c 100644 --- a/src/chemistry/mozart/mo_usrrxt.F90 +++ b/src/chemistry/mozart/mo_usrrxt.F90 @@ -2031,138 +2031,141 @@ subroutine usrrxt( rxt, temp, tempi, tempe, invariants, h2ovmr, & !----------------------------------------------------------------- ! ... CO tags !----------------------------------------------------------------- - if( usr_CO_OH_b_ndx > 0 ) then + if( usr_CO_OH_b_ndx > 0 .and. usr_CO_OH_ndx < 0 ) then + usr_CO_OH_ndx = usr_CO_OH_b_ndx + end if + if( usr_CO_OH_ndx > 0 ) then if( usr_COhc_OH_ndx > 0 ) then - rxt(:ncol,:,usr_COhc_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_COhc_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_COme_OH_ndx > 0 ) then - rxt(:ncol,:,usr_COme_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_COme_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO01_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO01_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO01_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO02_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO02_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO02_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO03_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO03_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO03_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO04_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO04_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO04_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO05_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO05_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO05_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO06_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO06_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO06_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO07_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO07_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO07_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO08_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO08_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO08_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO09_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO09_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO09_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO10_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO10_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO10_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO11_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO11_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO11_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO12_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO12_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO12_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO13_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO13_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO13_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO14_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO14_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO14_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO15_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO15_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO15_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO16_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO16_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO16_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO17_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO17_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO17_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO18_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO18_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO18_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO19_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO19_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO19_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO20_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO20_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO20_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO21_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO21_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO21_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO22_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO22_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO22_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO23_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO23_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO23_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO24_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO24_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO24_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO25_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO25_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO25_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO26_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO26_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO26_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO27_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO27_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO27_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO28_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO28_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO28_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO29_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO29_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO29_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO30_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO30_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO30_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO31_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO31_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO31_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO32_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO32_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO32_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO33_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO33_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO33_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO34_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO34_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO34_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO35_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO35_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO35_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO36_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO36_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO36_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO37_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO37_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO37_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO38_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO38_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO38_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO39_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO39_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO39_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO40_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO40_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO40_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO41_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO41_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO41_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO42_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO42_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO42_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if end if !lke-- diff --git a/src/chemistry/mozart/sv_decomp.F90 b/src/chemistry/mozart/sv_decomp.F90 deleted file mode 100644 index 0540f1f575..0000000000 --- a/src/chemistry/mozart/sv_decomp.F90 +++ /dev/null @@ -1,364 +0,0 @@ -!------------------------------------------------------------------------- -! purpose: singular value decomposition -! -! method: -! given a matrix a(1:m,1:n), with physical dimensions mp by np, -! this routine computes its singular value decomposition, -! the matrix u replaces a on output. the -! diagonal matrix of singular values w is output as a vector -! w(1:n). the matrix v (not the transpose v^t) is output as -! v(1:n,1:n). -! -! author: a. maute dec 2003 -! (* copyright (c) 1985 numerical recipes software -- svdcmp *! -! from numerical recipes 1986 pp. 60 or can be find on web-sites -!------------------------------------------------------------------------- - - module sv_decomp - - use shr_kind_mod, only : r8 => shr_kind_r8 - - implicit none - - private - public :: svdcmp - public :: svbksb - - integer, parameter :: nmax = 1600 - - contains - - subroutine svdcmp( a, m, n, mp, np, w, v ) -!------------------------------------------------------------------------- -! ... dummy arguments -!------------------------------------------------------------------------- - integer, intent(in) :: m - integer, intent(in) :: n - integer, intent(in) :: mp - integer, intent(in) :: np - real(r8), intent(inout) :: a(mp,np) - real(r8), intent(out) :: v(np,np) - real(r8), intent(out) :: w(np) - -!------------------------------------------------------------------------- -! ... local variables -!------------------------------------------------------------------------- - integer :: i, its, j, k, l, nm - real(r8) :: anorm - real(r8) :: c - real(r8) :: f - real(r8) :: g - real(r8) :: h - real(r8) :: s - real(r8) :: scale - real(r8) :: x, y, z - real(r8) :: rv1(nmax) - logical :: cnd1 - logical :: cnd2 - - g = 0.0_r8 - scale = 0.0_r8 - anorm = 0.0_r8 - -loop1 : & - do i = 1,n - l = i + 1 - rv1(i) = scale*g - g = 0.0_r8 - s = 0.0_r8 - scale = 0.0_r8 - if( i <= m ) then - do k = i,m - scale = scale + abs(a(k,i)) - end do - if( scale /= 0.0_r8 ) then - do k = i,m - a(k,i) = a(k,i)/scale - s = s + a(k,i)*a(k,i) - end do - f = a(i,i) - g = -sign(sqrt(s),f) - h = f*g - s - a(i,i) = f - g - if( i /= n ) then - do j = l,n - s = 0.0_r8 - do k = i,m - s = s + a(k,i)*a(k,j) - end do - f = s/h - do k = i,m - a(k,j) = a(k,j) + f*a(k,i) - end do - end do - end if - do k = i,m - a(k,i) = scale*a(k,i) - end do - endif - endif - w(i) = scale *g - g = 0.0_r8 - s = 0.0_r8 - scale = 0.0_r8 - if( i <= m .and. i /= n ) then - do k = l,n - scale = scale + abs(a(i,k)) - end do - if( scale /= 0.0_r8 ) then - do k = l,n - a(i,k) = a(i,k)/scale - s = s + a(i,k)*a(i,k) - end do - f = a(i,l) - g = -sign(sqrt(s),f) - h = f*g - s - a(i,l) = f - g - do k = l,n - rv1(k) = a(i,k)/h - end do - if( i /= m ) then - do j = l,m - s = 0.0_r8 - do k = l,n - s = s + a(j,k)*a(i,k) - end do - do k = l,n - a(j,k) = a(j,k) + s*rv1(k) - end do - end do - end if - do k = l,n - a(i,k) = scale*a(i,k) - end do - end if - end if - anorm = max( anorm,(abs(w(i)) + abs(rv1(i))) ) - end do loop1 - - do i = n,1,-1 - if( i < n ) then - if( g /= 0.0_r8 ) then - do j = l,n - v(j,i) = (a(i,j)/a(i,l))/g - end do - do j = l,n - s = 0.0_r8 - do k = l,n - s = s + a(i,k)*v(k,j) - end do - do k = l,n - v(k,j) = v(k,j) + s*v(k,i) - end do - end do - end if - do j = l,n - v(i,j) = 0.0_r8 - v(j,i) = 0.0_r8 - end do - end if - v(i,i) = 1.0_r8 - g = rv1(i) - l = i - end do - - do i = n,1,-1 - l = i + 1 - g = w(i) - if( i < n ) then - do j = l,n - a(i,j) = 0.0_r8 - end do - end if - if( g /= 0.0_r8 ) then - g = 1.0_r8/g - if( i /= n ) then - do j = l,n - s = 0.0_r8 - do k = l,m - s = s + a(k,i)*a(k,j) - end do - f = (s/a(i,i))*g - do k = i,m - a(k,j) = a(k,j) + f*a(k,i) - end do - end do - end if - do j = i,m - a(j,i) = a(j,i)*g - end do - else - do j = i,m - a(j,i) = 0.0_r8 - end do - end if - a(i,i) = a(i,i) + 1.0_r8 - end do - - do k = n,1,-1 -loop2 : do its = 1,30 - do l = k,1,-1 - nm = l - 1 - cnd1 = abs( rv1(l) ) + anorm == anorm - if( cnd1 ) then - cnd2 = .false. - exit - end if - cnd2 = abs( w(nm) ) + anorm == anorm - if( cnd2 ) then - cnd1 = .true. - exit - else if( l == 1 ) then - cnd1 = .true. - cnd2 = .true. - end if - end do - - if( cnd2 ) then - c = 0.0_r8 - s = 1.0_r8 - do i = l,k - f = s*rv1(i) - if( (abs(f) + anorm) /= anorm ) then - g = w(i) - h = sqrt(f*f + g*g) - w(i) = h - h = 1.0_r8/h - c = (g*h) - s = -(f*h) - do j = 1,m - y = a(j,nm) - z = a(j,i) - a(j,nm) = (y*c) + (z*s) - a(j,i) = -(y*s) + (z*c) - end do - end if - end do - end if - - if( cnd1 ) then - z = w(k) - if( l == k ) then - if( z < 0.0_r8 ) then - w(k) = -z - do j = 1,n - v(j,k) = -v(j,k) - end do - end if - exit loop2 - end if - end if - - x = w(l) - nm = k - 1 - y = w(nm) - g = rv1(nm) - h = rv1(k) - f = ((y - z)*(y + z) + (g - h)*(g + h))/(2.0_r8*h*y) - g = sqrt( f*f + 1.0_r8 ) - f = ((x - z)*(x + z) + h*((y/(f + sign(g,f))) - h))/x - c = 1.0_r8 - s = 1.0_r8 - do j = l,nm - i = j + 1 - g = rv1(i) - y = w(i) - h = s*g - g = c*g - z = sqrt( f*f + h*h ) - rv1(j) = z - c = f/z - s = h/z - f = (x*c)+(g*s) - g = -(x*s)+(g*c) - h = y*s - y = y*c - do nm = 1,n - x = v(nm,j) - z = v(nm,i) - v(nm,j) = (x*c)+(z*s) - v(nm,i) = -(x*s)+(z*c) - end do - z = sqrt( f*f + h*h ) - w(j) = z - if( z /= 0.0_r8 ) then - z = 1.0_r8/z - c = f*z - s = h*z - end if - f = (c*g)+(s*y) - x = -(s*g)+(c*y) - do nm = 1,m - y = a(nm,j) - z = a(nm,i) - a(nm,j) = (y*c)+(z*s) - a(nm,i) = -(y*s)+(z*c) - end do - end do - rv1(l) = 0.0_r8 - rv1(k) = f - w(k) = x - end do loop2 - end do - - end subroutine svdcmp - -!------------------------------------------------------------------------- -! purpose: solves a*x = b -! -! method: -! solves a*x = b for a vector x, where a is specified by the arrays -! u,w,v as returned by svdcmp. m and n -! are the logical dimensions of a, and will be equal for square matrices. -! mp and np are the physical dimensions of a. b(1:m) is the input right-hand -! side. x(1:n) is the output solution vector. no input quantities are -! destroyed, so the routine may be called sequentially with different b -! -! author: a. maute dec 2002 -! (* copyright (c) 1985 numerical recipes software -- svbksb *! -! from numerical recipes 1986 pp. 57 or can be find on web-sites -!------------------------------------------------------------------------- - - subroutine svbksb( u, w, v, m, n, mp, np, b, x ) -!------------------------------------------------------------------------- -! ... dummy arguments -!------------------------------------------------------------------------- - integer, intent(in) :: m - integer, intent(in) :: n - integer, intent(in) :: mp - integer, intent(in) :: np - real(r8), intent(in) :: u(mp,np) - real(r8), intent(in) :: w(np) - real(r8), intent(in) :: v(np,np) - real(r8), intent(in) :: b(mp) - real(r8), intent(out) :: x(np) - -!------------------------------------------------------------------------- -! ... local variables -!------------------------------------------------------------------------- - integer :: i, j, jj - real(r8) :: s - real(r8) :: tmp(nmax) - - do j = 1,n - s = 0._r8 - if( w(j) /= 0._r8 ) then - do i = 1,m - s = s + u(i,j)*b(i) - end do - s = s/w(j) - endif - tmp(j) = s - end do - - do j = 1,n - s = 0._r8 - do jj = 1,n - s = s + v(j,jj)*tmp(jj) - end do - x(j) = s - end do - - end subroutine svbksb - - end module sv_decomp diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/chem_mech.doc b/src/chemistry/pp_trop_strat_mam5_ts4/chem_mech.doc new file mode 100644 index 0000000000..56b6bbe782 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/chem_mech.doc @@ -0,0 +1,1126 @@ + + + Solution species + ( 1) bc_a1 (C) + ( 2) bc_a4 (C) + ( 3) BIGALK (C5H12) + ( 4) BR (Br) + ( 5) BRCL (BrCl) + ( 6) BRO (BrO) + ( 7) BRONO2 (BrONO2) + ( 8) BRY + ( 9) C2H4 + ( 10) C2H5OH + ( 11) C2H5OOH + ( 12) C2H6 + ( 13) C3H6 + ( 14) C3H7OOH + ( 15) C3H8 + ( 16) CCL4 (CCl4) + ( 17) CF2CLBR (CF2ClBr) + ( 18) CF3BR (CF3Br) + ( 19) CFC11 (CFCl3) + ( 20) CFC113 (CCl2FCClF2) + ( 21) CFC114 (CClF2CClF2) + ( 22) CFC115 (CClF2CF3) + ( 23) CFC12 (CF2Cl2) + ( 24) CH2BR2 (CH2Br2) + ( 25) CH2O + ( 26) CH3BR (CH3Br) + ( 27) CH3CCL3 (CH3CCl3) + ( 28) CH3CHO + ( 29) CH3CL (CH3Cl) + ( 30) CH3COCH3 + ( 31) CH3COCHO + ( 32) CH3COOH + ( 33) CH3COOOH + ( 34) CH3OH + ( 35) CH3OOH + ( 36) CH4 + ( 37) CHBR3 (CHBr3) + ( 38) CL (Cl) + ( 39) CL2 (Cl2) + ( 40) CL2O2 (Cl2O2) + ( 41) CLO (ClO) + ( 42) CLONO2 (ClONO2) + ( 43) CLY + ( 44) CO + ( 45) CO2 + ( 46) DMS (CH3SCH3) + ( 47) dst_a1 (AlSiO5) + ( 48) dst_a2 (AlSiO5) + ( 49) dst_a3 (AlSiO5) + ( 50) E90 (CO) + ( 51) EOOH (HOCH2CH2OOH) + ( 52) GLYALD (HOCH2CHO) + ( 53) GLYOXAL (C2H2O2) + ( 54) H + ( 55) H2 + ( 56) H2402 (CBrF2CBrF2) + ( 57) H2O2 + ( 58) H2SO4 (H2SO4) + ( 59) HBR (HBr) + ( 60) HCFC141B (CH3CCl2F) + ( 61) HCFC142B (CH3CClF2) + ( 62) HCFC22 (CHF2Cl) + ( 63) HCL (HCl) + ( 64) HF + ( 65) HNO3 + ( 66) HO2NO2 + ( 67) HOBR (HOBr) + ( 68) HOCL (HOCl) + ( 69) HYAC (CH3COCH2OH) + ( 70) HYDRALD (HOCH2CCH3CHCHO) + ( 71) ISOP (C5H8) + ( 72) ISOPNO3 (CH2CHCCH3OOCH2ONO2) + ( 73) ISOPOOH (HOCH2COOHCH3CHCH2) + ( 74) MACR (CH2CCH3CHO) + ( 75) MACROOH (CH3COCHOOHCH2OH) + ( 76) MPAN (CH2CCH3CO3NO2) + ( 77) MVK (CH2CHCOCH3) + ( 78) N + ( 79) N2O + ( 80) N2O5 + ( 81) ncl_a1 (NaCl) + ( 82) ncl_a2 (NaCl) + ( 83) ncl_a3 (NaCl) + ( 84) NH3 + ( 85) NH4 + ( 86) NH_5 (CO) + ( 87) NH_50 (CO) + ( 88) NO + ( 89) NO2 + ( 90) NO3 + ( 91) NOA (CH3COCH2ONO2) + ( 92) num_a1 (H) + ( 93) num_a2 (H) + ( 94) num_a3 (H) + ( 95) num_a4 (H) + ( 96) num_a5 (H) + ( 97) O + ( 98) O3 + ( 99) O3S (O3) + (100) OCLO (OClO) + (101) OCS (OCS) + (102) ONITR (C4H7NO4) + (103) PAN (CH3CO3NO2) + (104) pom_a1 (C) + (105) pom_a4 (C) + (106) POOH (C3H6OHOOH) + (107) ROOH (CH3COCH2OOH) + (108) S (S) + (109) SF6 + (110) SO (SO) + (111) SO2 + (112) SO3 (SO3) + (113) so4_a1 (NH4HSO4) + (114) so4_a2 (NH4HSO4) + (115) so4_a3 (NH4HSO4) + (116) so4_a5 (NH4HSO4) + (117) soa_a1 (C) + (118) soa_a2 (C) + (119) SOAE (C) + (120) SOAG (C) + (121) ST80_25 (CO) + (122) TERP (C10H16) + (123) XOOH (HOCH2COOHCH3CHOHCHO) + (124) NHDEP (N) + (125) NDEP (N) + (126) C2H5O2 + (127) C3H7O2 + (128) CH3CO3 + (129) CH3O2 + (130) EO (HOCH2CH2O) + (131) EO2 (HOCH2CH2O2) + (132) HO2 + (133) ISOPO2 (HOCH2COOCH3CHCH2) + (134) MACRO2 (CH3COCHO2CH2OH) + (135) MCO3 (CH2CCH3CO3) + (136) O1D (O) + (137) OH + (138) PO2 (C3H6OHO2) + (139) RO2 (CH3COCH2O2) + (140) XO2 (HOCH2COOCH3CHOHCHO) + (141) H2O + + + Invariant species + ( 1) M + ( 2) O2 + ( 3) N2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + Explicit + -------- + ( 1) NHDEP + ( 2) NDEP + + Implicit + -------- + ( 1) bc_a1 + ( 2) bc_a4 + ( 3) BIGALK + ( 4) BR + ( 5) BRCL + ( 6) BRO + ( 7) BRONO2 + ( 8) BRY + ( 9) C2H4 + ( 10) C2H5OH + ( 11) C2H5OOH + ( 12) C2H6 + ( 13) C3H6 + ( 14) C3H7OOH + ( 15) C3H8 + ( 16) CCL4 + ( 17) CF2CLBR + ( 18) CF3BR + ( 19) CFC11 + ( 20) CFC113 + ( 21) CFC114 + ( 22) CFC115 + ( 23) CFC12 + ( 24) CH2BR2 + ( 25) CH2O + ( 26) CH3BR + ( 27) CH3CCL3 + ( 28) CH3CHO + ( 29) CH3CL + ( 30) CH3COCH3 + ( 31) CH3COCHO + ( 32) CH3COOH + ( 33) CH3COOOH + ( 34) CH3OH + ( 35) CH3OOH + ( 36) CH4 + ( 37) CHBR3 + ( 38) CL + ( 39) CL2 + ( 40) CL2O2 + ( 41) CLO + ( 42) CLONO2 + ( 43) CLY + ( 44) CO + ( 45) CO2 + ( 46) DMS + ( 47) dst_a1 + ( 48) dst_a2 + ( 49) dst_a3 + ( 50) E90 + ( 51) EOOH + ( 52) GLYALD + ( 53) GLYOXAL + ( 54) H + ( 55) H2 + ( 56) H2402 + ( 57) H2O2 + ( 58) H2SO4 + ( 59) HBR + ( 60) HCFC141B + ( 61) HCFC142B + ( 62) HCFC22 + ( 63) HCL + ( 64) HF + ( 65) HNO3 + ( 66) HO2NO2 + ( 67) HOBR + ( 68) HOCL + ( 69) HYAC + ( 70) HYDRALD + ( 71) ISOP + ( 72) ISOPNO3 + ( 73) ISOPOOH + ( 74) MACR + ( 75) MACROOH + ( 76) MPAN + ( 77) MVK + ( 78) N + ( 79) N2O + ( 80) N2O5 + ( 81) ncl_a1 + ( 82) ncl_a2 + ( 83) ncl_a3 + ( 84) NH3 + ( 85) NH4 + ( 86) NH_5 + ( 87) NH_50 + ( 88) NO + ( 89) NO2 + ( 90) NO3 + ( 91) NOA + ( 92) num_a1 + ( 93) num_a2 + ( 94) num_a3 + ( 95) num_a4 + ( 96) num_a5 + ( 97) O + ( 98) O3 + ( 99) O3S + (100) OCLO + (101) OCS + (102) ONITR + (103) PAN + (104) pom_a1 + (105) pom_a4 + (106) POOH + (107) ROOH + (108) S + (109) SF6 + (110) SO + (111) SO2 + (112) SO3 + (113) so4_a1 + (114) so4_a2 + (115) so4_a3 + (116) so4_a5 + (117) soa_a1 + (118) soa_a2 + (119) SOAE + (120) SOAG + (121) ST80_25 + (122) TERP + (123) XOOH + (124) C2H5O2 + (125) C3H7O2 + (126) CH3CO3 + (127) CH3O2 + (128) EO + (129) EO2 + (130) HO2 + (131) ISOPO2 + (132) MACRO2 + (133) MCO3 + (134) O1D + (135) OH + (136) PO2 + (137) RO2 + (138) XO2 + (139) H2O + + Photolysis + jh2o_b ( 1) H2O + hv -> H2 + O1D rate = ** User defined ** ( 1) + jh2o_a ( 2) H2O + hv -> OH + H rate = ** User defined ** ( 2) + jh2o_c ( 3) H2O + hv -> 2*H + O rate = ** User defined ** ( 3) + jh2o2 ( 4) H2O2 + hv -> 2*OH rate = ** User defined ** ( 4) + jo2_a ( 5) O2 + hv -> O + O1D rate = ** User defined ** ( 5) + jo2_b ( 6) O2 + hv -> 2*O rate = ** User defined ** ( 6) + jo3_a ( 7) O3 + hv -> O1D + O2 rate = ** User defined ** ( 7) + jo3_b ( 8) O3 + hv -> O + O2 rate = ** User defined ** ( 8) + jhno3 ( 9) HNO3 + hv -> NO2 + OH rate = ** User defined ** ( 9) + jho2no2_a ( 10) HO2NO2 + hv -> OH + NO3 rate = ** User defined ** ( 10) + jho2no2_b ( 11) HO2NO2 + hv -> NO2 + HO2 rate = ** User defined ** ( 11) + jn2o ( 12) N2O + hv -> O1D + N2 rate = ** User defined ** ( 12) + jn2o5_a ( 13) N2O5 + hv -> NO2 + NO3 rate = ** User defined ** ( 13) + jn2o5_b ( 14) N2O5 + hv -> NO + O + NO3 rate = ** User defined ** ( 14) + jno ( 15) NO + hv -> N + O rate = ** User defined ** ( 15) + jno2 ( 16) NO2 + hv -> NO + O rate = ** User defined ** ( 16) + jno3_b ( 17) NO3 + hv -> NO + O2 rate = ** User defined ** ( 17) + jno3_a ( 18) NO3 + hv -> NO2 + O rate = ** User defined ** ( 18) + jc2h5ooh ( 19) C2H5OOH + hv -> CH3CHO + HO2 + OH rate = ** User defined ** ( 19) + jc3h7ooh ( 20) C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 rate = ** User defined ** ( 20) + jch2o_a ( 21) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 21) + jch2o_b ( 22) CH2O + hv -> CO + H2 rate = ** User defined ** ( 22) + jch3cho ( 23) CH3CHO + hv -> CH3O2 + CO + HO2 rate = ** User defined ** ( 23) + jacet ( 24) CH3COCH3 + hv -> CH3CO3 + CH3O2 rate = ** User defined ** ( 24) + jmgly ( 25) CH3COCHO + hv -> CH3CO3 + CO + HO2 rate = ** User defined ** ( 25) + jch3co3h ( 26) CH3COOOH + hv -> CH3O2 + OH + CO2 rate = ** User defined ** ( 26) + jch3ooh ( 27) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 27) + jch4_b ( 28) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 28) + + 0.44*CO2 + 0.38*CO + 0.05*H2O + jch4_a ( 29) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 29) + jco2 ( 30) CO2 + hv -> CO + O rate = ** User defined ** ( 30) + jeooh ( 31) EOOH + hv -> EO + OH rate = ** User defined ** ( 31) + jglyald ( 32) GLYALD + hv -> 2*HO2 + CO + CH2O rate = ** User defined ** ( 32) + jglyoxal ( 33) GLYOXAL + hv -> 2*CO + 2*HO2 rate = ** User defined ** ( 33) + jhyac ( 34) HYAC + hv -> CH3CO3 + HO2 + CH2O rate = ** User defined ** ( 34) + jisopooh ( 35) ISOPOOH + hv -> 0.402*MVK + 0.288*MACR + 0.69*CH2O + HO2 rate = ** User defined ** ( 35) + jmacr_a ( 36) MACR + hv -> 1.34*HO2 + 0.66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 rate = ** User defined ** ( 36) + jmacr_b ( 37) MACR + hv -> 0.66*HO2 + 1.34*CO rate = ** User defined ** ( 37) + jmpan ( 38) MPAN + hv -> MCO3 + NO2 rate = ** User defined ** ( 38) + jmvk ( 39) MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 rate = ** User defined ** ( 39) + jnoa ( 40) NOA + hv -> NO2 + CH2O + CH3CO3 rate = ** User defined ** ( 40) + jonitr ( 41) ONITR + hv -> HO2 + CO + NO2 + CH2O rate = ** User defined ** ( 41) + jpan ( 42) PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 rate = ** User defined ** ( 42) + jpooh ( 43) POOH + hv -> CH3CHO + CH2O + HO2 + OH rate = ** User defined ** ( 43) + jrooh ( 44) ROOH + hv -> CH3CO3 + CH2O + OH rate = ** User defined ** ( 44) + jxooh ( 45) XOOH + hv -> OH rate = ** User defined ** ( 45) + jbrcl ( 46) BRCL + hv -> BR + CL rate = ** User defined ** ( 46) + jbro ( 47) BRO + hv -> BR + O rate = ** User defined ** ( 47) + jbrono2_b ( 48) BRONO2 + hv -> BRO + NO2 rate = ** User defined ** ( 48) + jbrono2_a ( 49) BRONO2 + hv -> BR + NO3 rate = ** User defined ** ( 49) + jccl4 ( 50) CCL4 + hv -> 4*CL rate = ** User defined ** ( 50) + jcf2clbr ( 51) CF2CLBR + hv -> BR + CL + {COF2} rate = ** User defined ** ( 51) + jcf3br ( 52) CF3BR + hv -> BR + {F} + {COF2} rate = ** User defined ** ( 52) + jcfcl3 ( 53) CFC11 + hv -> 3*CL rate = ** User defined ** ( 53) + jcfc113 ( 54) CFC113 + hv -> 3*CL rate = ** User defined ** ( 54) + jcfc114 ( 55) CFC114 + hv -> 2*CL + 2*{COF2} rate = ** User defined ** ( 55) + jcfc115 ( 56) CFC115 + hv -> CL + {F} + 2*{COF2} rate = ** User defined ** ( 56) + jcf2cl2 ( 57) CFC12 + hv -> 2*CL + {COF2} rate = ** User defined ** ( 57) + jch2br2 ( 58) CH2BR2 + hv -> 2*BR rate = ** User defined ** ( 58) + jch3br ( 59) CH3BR + hv -> BR + CH3O2 rate = ** User defined ** ( 59) + jch3ccl3 ( 60) CH3CCL3 + hv -> 3*CL rate = ** User defined ** ( 60) + jch3cl ( 61) CH3CL + hv -> CL + CH3O2 rate = ** User defined ** ( 61) + jchbr3 ( 62) CHBR3 + hv -> 3*BR rate = ** User defined ** ( 62) + jcl2 ( 63) CL2 + hv -> 2*CL rate = ** User defined ** ( 63) + jcl2o2 ( 64) CL2O2 + hv -> 2*CL rate = ** User defined ** ( 64) + jclo ( 65) CLO + hv -> CL + O rate = ** User defined ** ( 65) + jclono2_b ( 66) CLONO2 + hv -> CLO + NO2 rate = ** User defined ** ( 66) + jclono2_a ( 67) CLONO2 + hv -> CL + NO3 rate = ** User defined ** ( 67) + jh2402 ( 68) H2402 + hv -> 2*BR + 2*{COF2} rate = ** User defined ** ( 68) + jhbr ( 69) HBR + hv -> BR + H rate = ** User defined ** ( 69) + jhcfc141b ( 70) HCFC141B + hv -> CL + {COFCL} rate = ** User defined ** ( 70) + jhcfc142b ( 71) HCFC142B + hv -> CL + {COF2} rate = ** User defined ** ( 71) + jhcfc22 ( 72) HCFC22 + hv -> CL + {COF2} rate = ** User defined ** ( 72) + jhcl ( 73) HCL + hv -> H + CL rate = ** User defined ** ( 73) + jhf ( 74) HF + hv -> H + {F} rate = ** User defined ** ( 74) + jhobr ( 75) HOBR + hv -> BR + OH rate = ** User defined ** ( 75) + jhocl ( 76) HOCL + hv -> OH + CL rate = ** User defined ** ( 76) + joclo ( 77) OCLO + hv -> O + CLO rate = ** User defined ** ( 77) + jsf6 ( 78) SF6 + hv -> {sink} rate = ** User defined ** ( 78) + jh2so4 ( 79) H2SO4 + hv -> SO3 + H2O rate = ** User defined ** ( 79) + jocs ( 80) OCS + hv -> S + CO rate = ** User defined ** ( 80) + jso ( 81) SO + hv -> S + O rate = ** User defined ** ( 81) + jso2 ( 82) SO2 + hv -> SO + O rate = ** User defined ** ( 82) + jso3 ( 83) SO3 + hv -> SO2 + O rate = ** User defined ** ( 83) + jsoa_a1 ( 84) soa_a1 + hv -> (No products) rate = ** User defined ** ( 84) + jsoa_a2 ( 85) soa_a2 + hv -> (No products) rate = ** User defined ** ( 85) + + Reactions + O1D_H2 ( 1) O1D + H2 -> H + OH rate = 1.20E-10 ( 86) + O1D_H2O ( 2) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) ( 87) + O1D_N2 ( 3) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) ( 88) + O1D_O2ab ( 4) O1D + O2 -> O + O2 rate = 3.30E-11*exp( 55./t) ( 89) + O1D_O3 ( 5) O1D + O3 -> O2 + O2 rate = 1.20E-10 ( 90) + O1D_O3a ( 6) O1D + O3 -> O2 + 2*O rate = 1.20E-10 ( 91) + O_O3 ( 7) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) ( 92) + usr_O_O ( 8) O + O + M -> O2 + M rate = ** User defined ** ( 93) + usr_O_O2 ( 9) O + O2 + M -> O3 + M rate = ** User defined ** ( 94) + H2_O ( 10) H2 + O -> OH + H rate = 1.60E-11*exp( -4570./t) ( 95) + H2O2_O ( 11) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) ( 96) + H_HO2 ( 12) H + HO2 -> H2 + O2 rate = 6.90E-12 ( 97) + H_HO2a ( 13) H + HO2 -> 2*OH rate = 7.20E-11 ( 98) + H_HO2b ( 14) H + HO2 -> H2O + O rate = 1.60E-12 ( 99) + H_O2 ( 15) H + O2 + M -> HO2 + M troe : ko=5.30E-32*(300/t)**1.80 (100) + ki=9.50E-11*(300/t)**-0.40 + f=0.60 + HO2_O ( 16) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (101) + HO2_O3 ( 17) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (102) + H_O3 ( 18) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (103) + OH_H2 ( 19) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (104) + OH_H2O2 ( 20) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (105) + OH_HO2 ( 21) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (106) + OH_O ( 22) OH + O -> H + O2 rate = 1.80E-11*exp( 180./t) (107) + OH_O3 ( 23) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (108) + OH_OH ( 24) OH + OH -> H2O + O rate = 1.80E-12 (109) + OH_OH_M ( 25) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (110) + ki=2.60E-11 + f=0.60 + usr_HO2_HO2 ( 26) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (111) + HO2NO2_OH ( 27) HO2NO2 + OH -> H2O + NO2 + O2 rate = 4.50E-13*exp( 610./t) (112) + N_NO ( 28) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (113) + N_NO2a ( 29) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (114) + N_NO2b ( 30) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (115) + N_NO2c ( 31) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (116) + N_O2 ( 32) N + O2 -> NO + O rate = 3.30E-12*exp( -3150./t) (117) + NO2_O ( 33) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (118) + NO2_O3 ( 34) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (119) + NO2_O_M ( 35) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (120) + ki=2.20E-11*(300/t)**0.70 + f=0.60 + NO3_HO2 ( 36) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (121) + NO3_NO ( 37) NO3 + NO -> 2*NO2 rate = 1.70E-11*exp( 125./t) (122) + NO3_O ( 38) NO3 + O -> NO2 + O2 rate = 1.30E-11 (123) + NO3_OH ( 39) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (124) + N_OH ( 40) N + OH -> NO + H rate = 5.00E-11 (125) + NO_HO2 ( 41) NO + HO2 -> NO2 + OH rate = 3.44E-12*exp( 260./t) (126) + NO_O3 ( 42) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (127) + NO_O_M ( 43) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (128) + ki=3.00E-11 + f=0.60 + O1D_N2Oa ( 44) O1D + N2O -> 2*NO rate = 7.26E-11*exp( 20./t) (129) + O1D_N2Ob ( 45) O1D + N2O -> N2 + O2 rate = 4.64E-11*exp( 20./t) (130) + tag_NO2_HO2 ( 46) NO2 + HO2 + M -> HO2NO2 + M troe : ko=1.90E-31*(300/t)**3.40 (131) + ki=4.00E-12*(300/t)**0.30 + f=0.60 + tag_NO2_NO3 ( 47) NO2 + NO3 + M -> N2O5 + M troe : ko=2.40E-30*(300/t)**3.00 (132) + ki=1.60E-12*(300/t)**-0.10 + f=0.60 + tag_NO2_OH ( 48) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 (133) + ki=2.80E-11 + f=0.60 + usr_HNO3_OH ( 49) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (134) + usr_HO2NO2_M ( 50) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (135) + usr_N2O5_M ( 51) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (136) + CL_CH2O ( 52) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (137) + CL_CH4 ( 53) CL + CH4 -> CH3O2 + HCL rate = 7.10E-12*exp( -1270./t) (138) + CL_H2 ( 54) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (139) + CL_H2O2 ( 55) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (140) + CL_HO2a ( 56) CL + HO2 -> HCL + O2 rate = 1.40E-11*exp( 270./t) (141) + CL_HO2b ( 57) CL + HO2 -> OH + CLO rate = 3.60E-11*exp( -375./t) (142) + CL_O3 ( 58) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (143) + CLO_CH3O2 ( 59) CLO + CH3O2 -> CL + HO2 + CH2O rate = 3.30E-12*exp( -115./t) (144) + CLO_CLOa ( 60) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (145) + CLO_CLOb ( 61) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (146) + CLO_CLOc ( 62) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (147) + CLO_HO2 ( 63) CLO + HO2 -> O2 + HOCL rate = 2.60E-12*exp( 290./t) (148) + CLO_NO ( 64) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (149) + CLONO2_CL ( 65) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (150) + CLO_NO2_M ( 66) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (151) + ki=1.50E-11*(300/t)**1.90 + f=0.60 + CLONO2_O ( 67) CLONO2 + O -> CLO + NO3 rate = 3.60E-12*exp( -840./t) (152) + CLONO2_OH ( 68) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (153) + CLO_O ( 69) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (154) + CLO_OHa ( 70) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (155) + CLO_OHb ( 71) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (156) + HCL_O ( 72) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (157) + HCL_OH ( 73) HCL + OH -> H2O + CL rate = 1.80E-12*exp( -250./t) (158) + HOCL_CL ( 74) HOCL + CL -> HCL + CLO rate = 3.40E-12*exp( -130./t) (159) + HOCL_O ( 75) HOCL + O -> CLO + OH rate = 1.70E-13 (160) + HOCL_OH ( 76) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (161) + O1D_CCL4 ( 77) O1D + CCL4 -> 4*CL rate = 2.61E-10 (162) + O1D_CF2CLBR ( 78) O1D + CF2CLBR -> CL + BR + {COF2} rate = 9.75E-11 (163) + O1D_CFC11 ( 79) O1D + CFC11 -> 3*CL rate = 2.07E-10 (164) + O1D_CFC113 ( 80) O1D + CFC113 -> 3*CL rate = 2.09E-10 (165) + O1D_CFC114 ( 81) O1D + CFC114 -> 2*CL + 2*{COF2} rate = 1.17E-10 (166) + O1D_CFC115 ( 82) O1D + CFC115 -> CL + {F} + 2*{COF2} rate = 4.64E-11 (167) + O1D_CFC12 ( 83) O1D + CFC12 -> 2*CL + {COF2} rate = 1.20E-10 (168) + O1D_HCLa ( 84) O1D + HCL -> CL + OH rate = 9.90E-11 (169) + O1D_HCLb ( 85) O1D + HCL -> CLO + H rate = 3.30E-12 (170) + tag_CLO_CLO_M ( 86) CLO + CLO + M -> CL2O2 + M troe : ko=1.90E-32*(300/t)**3.60 (171) + ki=3.70E-12*(300/t)**1.60 + f=0.60 + usr_CL2O2_M ( 87) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (172) + BR_CH2O ( 88) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (173) + BR_HO2 ( 89) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (174) + BR_O3 ( 90) BR + O3 -> BRO + O2 rate = 1.60E-11*exp( -780./t) (175) + BRO_BRO ( 91) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (176) + BRO_CLOa ( 92) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (177) + BRO_CLOb ( 93) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (178) + BRO_CLOc ( 94) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (179) + BRO_HO2 ( 95) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (180) + BRO_NO ( 96) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (181) + BRO_NO2_M ( 97) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (182) + ki=6.90E-12*(300/t)**2.90 + f=0.60 + BRONO2_O ( 98) BRONO2 + O -> BRO + NO3 rate = 1.90E-11*exp( 215./t) (183) + BRO_O ( 99) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (184) + BRO_OH (100) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (185) + HBR_O (101) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (186) + HBR_OH (102) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (187) + HOBR_O (103) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (188) + O1D_CF3BR (104) O1D + CF3BR -> BR + {F} + {COF2} rate = 4.50E-11 (189) + O1D_CHBR3 (105) O1D + CHBR3 -> 3*BR rate = 4.62E-10 (190) + O1D_H2402 (106) O1D + H2402 -> 2*BR + 2*{COF2} rate = 1.20E-10 (191) + O1D_HBRa (107) O1D + HBR -> BR + OH rate = 9.00E-11 (192) + O1D_HBRb (108) O1D + HBR -> BRO + H rate = 3.00E-11 (193) + CH2BR2_CL (109) CH2BR2 + CL -> 2*BR + HCL rate = 6.30E-12*exp( -800./t) (194) + CH2BR2_OH (110) CH2BR2 + OH -> 2*BR + H2O rate = 2.00E-12*exp( -840./t) (195) + CH3BR_CL (111) CH3BR + CL -> HCL + HO2 + BR rate = 1.46E-11*exp( -1040./t) (196) + CH3BR_OH (112) CH3BR + OH -> BR + H2O + HO2 rate = 1.42E-12*exp( -1150./t) (197) + CH3CCL3_OH (113) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (198) + CH3CL_CL (114) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1100./t) (199) + CH3CL_OH (115) CH3CL + OH -> CL + H2O + HO2 rate = 1.96E-12*exp( -1200./t) (200) + CHBR3_CL (116) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (201) + CHBR3_OH (117) CHBR3 + OH -> 3*BR rate = 9.00E-13*exp( -360./t) (202) + HCFC141B_OH (118) HCFC141B + OH -> CL + CL rate = 1.25E-12*exp( -1600./t) (203) + HCFC142B_OH (119) HCFC142B + OH -> CL + {COF2} rate = 1.30E-12*exp( -1770./t) (204) + HCFC22_OH (120) HCFC22 + OH -> H2O + CL + {COF2} rate = 9.20E-13*exp( -1560./t) (205) + O1D_CH2BR2 (121) O1D + CH2BR2 -> 2*BR rate = 2.57E-10 (206) + O1D_CH3BR (122) O1D + CH3BR -> BR rate = 1.80E-10 (207) + O1D_HCFC141B (123) O1D + HCFC141B -> CL + CL rate = 1.79E-10 (208) + O1D_HCFC142B (124) O1D + HCFC142B -> CL + {COF2} rate = 1.30E-10 (209) + O1D_HCFC22 (125) O1D + HCFC22 -> CL + {COF2} rate = 7.65E-11 (210) + CH2O_NO3 (126) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) (211) + CH2O_O (127) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (212) + CH2O_OH (128) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (213) + CH3O2_CH3O2a (129) CH3O2 + CH3O2 -> 2*CH2O + 2*HO2 rate = 5.00E-13*exp( -424./t) (214) + CH3O2_CH3O2b (130) CH3O2 + CH3O2 -> CH2O + CH3OH rate = 1.90E-14*exp( 706./t) (215) + CH3O2_HO2 (131) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (216) + CH3O2_NO (132) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (217) + CH3OH_OH (133) CH3OH + OH -> HO2 + CH2O rate = 2.90E-12*exp( -345./t) (218) + CH3OOH_OH (134) CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (219) + CH4_OH (135) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (220) + O1D_CH4a (136) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (221) + O1D_CH4b (137) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (222) + O1D_CH4c (138) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (223) + usr_CO_OH (139) CO + OH -> CO2 + HO2 rate = ** User defined ** (224) + C2H4_CL_M (140) C2H4 + CL + M -> CL + M troe : ko=1.60E-29*(300/t)**3.30 (225) + ki=3.10E-10*(300/t) + f=0.60 + C2H4_O3 (141) C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*{HCOOH} + CH2O rate = 1.20E-14*exp( -2630./t) (226) + C2H5O2_C2H5O2 (142) C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH rate = 6.80E-14 (227) + C2H5O2_CH3O2 (143) C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH rate = 2.00E-13 (228) + + 0.2*C2H5OH + C2H5O2_HO2 (144) C2H5O2 + HO2 -> C2H5OOH + O2 rate = 7.50E-13*exp( 700./t) (229) + C2H5O2_NO (145) C2H5O2 + NO -> CH3CHO + HO2 + NO2 rate = 2.60E-12*exp( 365./t) (230) + C2H5OH_OH (146) C2H5OH + OH -> HO2 + CH3CHO rate = 6.90E-12*exp( -230./t) (231) + C2H5OOH_OH (147) C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH rate = 3.80E-12*exp( 200./t) (232) + C2H6_CL (148) C2H6 + CL -> HCL + C2H5O2 rate = 7.20E-11*exp( -70./t) (233) + C2H6_OH (149) C2H6 + OH -> C2H5O2 + H2O rate = 7.66E-12*exp( -1020./t) (234) + CH3CHO_NO3 (150) CH3CHO + NO3 -> CH3CO3 + HNO3 rate = 1.40E-12*exp( -1900./t) (235) + CH3CHO_OH (151) CH3CHO + OH -> CH3CO3 + H2O rate = 4.63E-12*exp( 350./t) (236) + CH3CO3_CH3CO3 (152) CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 rate = 2.90E-12*exp( 500./t) (237) + CH3CO3_CH3O2 (153) CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 rate = 2.00E-12*exp( 500./t) (238) + + 0.1*CH3COOH + CH3CO3_HO2 (154) CH3CO3 + HO2 -> 0.4*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.45*OH rate = 4.30E-13*exp( 1040./t) (239) + + 0.45*CH3O2 + CH3CO3_NO (155) CH3CO3 + NO -> CH3O2 + CO2 + NO2 rate = 8.10E-12*exp( 270./t) (240) + CH3COOH_OH (156) CH3COOH + OH -> CH3O2 + CO2 + H2O rate = 3.15E-14*exp( 920./t) (241) + CH3COOOH_OH (157) CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O rate = 1.00E-12 (242) + EO2_HO2 (158) EO2 + HO2 -> EOOH rate = 7.50E-13*exp( 700./t) (243) + EO2_NO (159) EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 rate = 4.20E-12*exp( 180./t) (244) + EO_M (160) EO -> 2*CH2O + HO2 rate = 1.60E+11*exp( -4150./t) (245) + EO_O2 (161) EO + O2 -> GLYALD + HO2 rate = 1.00E-14 (246) + GLYALD_OH (162) GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 rate = 1.00E-11 (247) + GLYOXAL_OH (163) GLYOXAL + OH -> HO2 + CO + CO2 rate = 1.15E-11 (248) + PAN_OH (164) PAN + OH -> CH2O + NO3 rate = 4.00E-14 (249) + tag_C2H4_OH (165) C2H4 + OH + M -> EO2 + M troe : ko=8.60E-29*(300/t)**3.10 (250) + ki=9.00E-12*(300/t)**0.85 + f=0.48 + tag_CH3CO3_NO2 (166) CH3CO3 + NO2 + M -> PAN + M troe : ko=7.30E-29*(300/t)**4.10 (251) + ki=9.50E-12*(300/t)**1.60 + f=0.60 + usr_PAN_M (167) PAN + M -> CH3CO3 + NO2 + M rate = ** User defined ** (252) + C3H6_NO3 (168) C3H6 + NO3 -> NOA rate = 4.60E-13*exp( -1156./t) (253) + C3H6_O3 (169) C3H6 + O3 -> 0.5*CH2O + 0.12*{HCOOH} + 0.12*CH3COOH + 0.5*CH3CHO rate = 6.50E-15*exp( -1900./t) (254) + + 0.56*CO + 0.28*CH3O2 + 0.1*CH4 + 0.2*CO2 + 0.28*HO2 + + 0.36*OH + C3H7O2_CH3O2 (170) C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 rate = 3.75E-13*exp( -40./t) (255) + C3H7O2_HO2 (171) C3H7O2 + HO2 -> C3H7OOH + O2 rate = 7.50E-13*exp( 700./t) (256) + C3H7O2_NO (172) C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO rate = 4.20E-12*exp( 180./t) (257) + C3H7OOH_OH (173) C3H7OOH + OH -> H2O + C3H7O2 rate = 3.80E-12*exp( 200./t) (258) + C3H8_OH (174) C3H8 + OH -> C3H7O2 + H2O rate = 9.19E-12*exp( -630./t) (259) + CH3COCHO_NO3 (175) CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 rate = 1.40E-12*exp( -1860./t) (260) + CH3COCHO_OH (176) CH3COCHO + OH -> CH3CO3 + CO + H2O rate = 8.40E-13*exp( 830./t) (261) + HYAC_OH (177) HYAC + OH -> CH3COCHO + HO2 rate = 3.00E-12 (262) + NOA_OH (178) NOA + OH -> NO2 + CH3COCHO rate = 6.70E-13 (263) + PO2_HO2 (179) PO2 + HO2 -> POOH + O2 rate = 7.50E-13*exp( 700./t) (264) + PO2_NO (180) PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 rate = 4.20E-12*exp( 180./t) (265) + POOH_OH (181) POOH + OH -> 0.5*PO2 + 0.5*OH + 0.5*HYAC + H2O rate = 3.80E-12*exp( 200./t) (266) + RO2_CH3O2 (182) RO2 + CH3O2 -> 0.3*CH3CO3 + 0.8*CH2O + 0.3*HO2 + 0.2*HYAC rate = 7.10E-13*exp( 500./t) (267) + + 0.5*CH3COCHO + 0.5*CH3OH + RO2_HO2 (183) RO2 + HO2 -> 0.85*ROOH + 0.15*OH + 0.15*CH2O + 0.15*CH3CO3 rate = 8.60E-13*exp( 700./t) (268) + RO2_NO (184) RO2 + NO -> CH3CO3 + CH2O + NO2 rate = 2.90E-12*exp( 300./t) (269) + ROOH_OH (185) ROOH + OH -> RO2 + H2O rate = 3.80E-12*exp( 200./t) (270) + tag_C3H6_OH (186) C3H6 + OH + M -> PO2 + M troe : ko=8.00E-27*(300/t)**3.50 (271) + ki=3.00E-11 + f=0.50 + usr_CH3COCH3_OH (187) CH3COCH3 + OH -> RO2 + H2O rate = ** User defined ** (272) + MACRO2_CH3CO3 (188) MACRO2 + CH3CO3 -> 0.25*CH3COCHO + CH3O2 + 0.22*CO + 0.47*HO2 rate = 1.40E-11 (273) + + 0.53*GLYALD + 0.22*HYAC + 0.25*CH2O + + 0.53*CH3CO3 + MACRO2_CH3O2 (189) MACRO2 + CH3O2 -> 0.73*HO2 + 0.88*CH2O + 0.11*CO + 0.24*CH3COCHO rate = 5.00E-13*exp( 400./t) (274) + + 0.26*GLYALD + 0.26*CH3CO3 + 0.25*CH3OH + + 0.23*HYAC + MACRO2_HO2 (190) MACRO2 + HO2 -> MACROOH rate = 8.00E-13*exp( 700./t) (275) + MACRO2_NO3 (191) MACRO2 + NO3 -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.25*CH3COCHO rate = 2.40E-12 (276) + + 0.22*CO + 0.53*GLYALD + 0.22*HYAC + 0.53*CH3CO3 + MACRO2_NOa (192) MACRO2 + NO -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.53*GLYALD rate = 2.70E-12*exp( 360./t) (277) + + 0.25*CH3COCHO + 0.53*CH3CO3 + 0.22*HYAC + 0.22*CO + MACRO2_NOb (193) MACRO2 + NO -> 0.8*ONITR rate = 1.30E-13*exp( 360./t) (278) + MACR_O3 (194) MACR + O3 -> 0.12*CH2O + 0.24*OH + 0.65*CO + 0.1*CH3CO3 rate = 1.50E-15*exp( -2100./t) (279) + + 0.88*CH3COCHO + 0.33*{HCOOH} + 0.14*HO2 + MACR_OH (195) MACR + OH -> 0.5*MACRO2 + 0.5*H2O + 0.5*MCO3 rate = 9.60E-12*exp( 360./t) (280) + MACROOH_OH (196) MACROOH + OH -> 0.5*MCO3 + 0.2*MACRO2 + 0.1*OH + 0.2*HO2 rate = 2.30E-11*exp( 200./t) (281) + MCO3_CH3CO3 (197) MCO3 + CH3CO3 -> 2*CO2 + CH3O2 + CH2O + CH3CO3 rate = 4.60E-12*exp( 530./t) (282) + MCO3_CH3O2 (198) MCO3 + CH3O2 -> 2*CH2O + HO2 + CO2 + CH3CO3 rate = 2.00E-12*exp( 500./t) (283) + MCO3_HO2 (199) MCO3 + HO2 -> 0.15*O3 + 0.15*CH3COOH + 0.4*CH3COOOH + 0.45*OH rate = 4.30E-13*exp( 1040./t) (284) + + 0.45*CO2 + 0.45*CH2O + 0.45*CH3CO3 + MCO3_MCO3 (200) MCO3 + MCO3 -> 2*CO2 + 2*CH2O + 2*CH3CO3 rate = 2.30E-12*exp( 530./t) (285) + MCO3_NO (201) MCO3 + NO -> NO2 + CH2O + CH3CO3 rate = 5.30E-12*exp( 360./t) (286) + MCO3_NO3 (202) MCO3 + NO3 -> NO2 + CH2O + CH3CO3 rate = 5.00E-12 (287) + MPAN_OH_M (203) MPAN + OH + M -> 0.5*HYAC + 0.5*NO3 + 0.5*CH2O + 0.5*HO2 + 0.5*CO2 troe : ko=8.00E-27*(300/t)**3.50 (288) + + M + 0.5*NDEP ki=3.00E-11 + f=0.50 + MVK_O3 (204) MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 rate = 8.50E-16*exp( -1520./t) (289) + + 0.5*CH3COCHO + 0.28*HO2 + 0.36*OH + 0.12*{HCOOH} + MVK_OH (205) MVK + OH -> MACRO2 rate = 4.13E-12*exp( 452./t) (290) + tag_MCO3_NO2 (206) MCO3 + NO2 + M -> MPAN + M troe : ko=9.70E-29*(300/t)**5.60 (291) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + usr_MPAN_M (207) MPAN + M -> MCO3 + NO2 + M rate = ** User defined ** (292) + BIGALK_OH (208) BIGALK + OH -> 1.67*C3H7O2 rate = 3.50E-12 (293) + HYDRALD_OH (209) HYDRALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (294) + ISOP_NO3 (210) ISOP + NO3 -> ISOPNO3 rate = 3.03E-12*exp( -446./t) (295) + ISOPNO3_HO2 (211) ISOPNO3 + HO2 -> 0.206*NO2 + 0.206*CH2O + 0.206*OH + 0.167*MACR rate = 8.00E-13*exp( 700./t) (296) + + 0.039*MVK + 0.794*ONITR + ISOPNO3_NO (212) ISOPNO3 + NO -> 1.206*NO2 + 0.794*HO2 + 0.072*CH2O + 0.167*MACR rate = 2.70E-12*exp( 360./t) (297) + + 0.039*MVK + 0.794*ONITR + ISOPNO3_NO3 (213) ISOPNO3 + NO3 -> 1.206*NO2 + 0.072*CH2O + 0.167*MACR + 0.039*MVK rate = 2.40E-12 (298) + + 0.794*ONITR + 0.794*HO2 + ISOPO2_CH3CO3 (214) ISOPO2 + CH3CO3 -> CH3O2 + HO2 + 0.6*CH2O + 0.25*MACR + 0.35*MVK rate = 1.40E-11 (299) + + 0.4*HYDRALD + ISOPO2_CH3O2 (215) ISOPO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.2*CH2O + 0.19*MACR rate = 5.00E-13*exp( 400./t) (300) + + 0.26*MVK + 0.3*HYDRALD + ISOPO2_HO2 (216) ISOPO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (301) + ISOPO2_NO (217) ISOPO2 + NO -> 0.08*ONITR + 0.92*NO2 + 0.23*MACR + 0.32*MVK rate = 4.40E-12*exp( 180./t) (302) + + 0.33*HYDRALD + 0.02*GLYOXAL + 0.02*GLYALD + + 0.02*CH3COCHO + 0.02*HYAC + 0.55*CH2O + 0.92*HO2 + ISOPO2_NO3 (218) ISOPO2 + NO3 -> HO2 + NO2 + 0.6*CH2O + 0.25*MACR + 0.35*MVK rate = 2.40E-12 (303) + + 0.4*HYDRALD + ISOP_O3 (219) ISOP + O3 -> 0.3*MACR + 0.2*MVK + 0.11*{HCOOH} + 0.62*CO + 0.32*OH rate = 1.05E-14*exp( -2000./t) (304) + + 0.37*HO2 + 0.91*CH2O + 0.08*CH3CO3 + 0.13*C3H6 + + 0.05*CH3O2 + ISOP_OH (220) ISOP + OH -> ISOPO2 rate = 2.54E-11*exp( 410./t) (305) + ISOPOOH_OH (221) ISOPOOH + OH -> 0.8*XO2 + 0.2*ISOPO2 rate = 1.52E-11*exp( 200./t) (306) + ONITR_NO3 (222) ONITR + NO3 -> HO2 + NO2 + HYDRALD rate = 1.40E-12*exp( -1860./t) (307) + ONITR_OH (223) ONITR + OH -> HYDRALD + 0.4*NO2 + HO2 rate = 4.50E-11 (308) + XO2_CH3CO3 (224) XO2 + CH3CO3 -> 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + CH3O2 + HO2 rate = 1.30E-12*exp( 640./t) (309) + + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + CO2 + XO2_CH3O2 (225) XO2 + CH3O2 -> 0.3*CH3OH + 0.8*HO2 + 0.8*CH2O + 0.2*CO rate = 5.00E-13*exp( 400./t) (310) + + 0.1*GLYOXAL + 0.1*CH3COCHO + 0.1*HYAC + 0.1*GLYALD + XO2_HO2 (226) XO2 + HO2 -> XOOH rate = 8.00E-13*exp( 700./t) (311) + XO2_NO (227) XO2 + NO -> NO2 + HO2 + 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL rate = 2.70E-12*exp( 360./t) (312) + + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + XO2_NO3 (228) XO2 + NO3 -> NO2 + HO2 + 0.5*CO + 0.25*HYAC + 0.25*GLYOXAL rate = 2.40E-12 (313) + + 0.25*CH3COCHO + 0.25*GLYALD + XOOH_OH (229) XOOH + OH -> 0.5*XO2 + 0.5*OH rate = 1.52E-12*exp( 200./t) (314) + TERP_NO3 (230) TERP + NO3 -> 1.7*ISOPO2 + NO2 rate = 1.20E-12*exp( 490./t) (315) + TERP_O3 (231) TERP + O3 -> 1.122*MACR + 0.442*MVK + 0.765*O + 1.156*OH rate = 6.30E-16*exp( -580./t) (316) + TERP_OH (232) TERP + OH -> 1.64*ISOPO2 + 0.1*CH3COCH3 rate = 1.20E-11*exp( 440./t) (317) + DMS_NO3 (233) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (318) + DMS_OHa (234) DMS + OH -> SO2 rate = 1.10E-11*exp( -280./t) (319) + OCS_O (235) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (320) + OCS_OH (236) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (321) + S_O2 (237) S + O2 -> SO + O rate = 2.30E-12 (322) + SO2_OH_M (238) SO2 + OH + M -> SO3 + HO2 troe : ko=2.90E-31*(300/t)**4.10 (323) + ki=1.70E-12*(300/t)**-0.20 + f=0.60 + S_O3 (239) S + O3 -> SO + O2 rate = 1.20E-11 (324) + SO_BRO (240) SO + BRO -> SO2 + BR rate = 5.70E-11 (325) + SO_CLO (241) SO + CLO -> SO2 + CL rate = 2.80E-11 (326) + S_OH (242) S + OH -> SO + H rate = 6.60E-11 (327) + SO_NO2 (243) SO + NO2 -> SO2 + NO rate = 1.40E-11 (328) + SO_O2 (244) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (329) + SO_O3 (245) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (330) + SO_OCLO (246) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (331) + SO_OH (247) SO + OH -> SO2 + H rate = 2.60E-11*exp( 330./t) (332) + usr_DMS_OH (248) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (333) + usr_SO3_H2O (249) SO3 + H2O -> H2SO4 rate = ** User defined ** (334) + NH3_OH (250) NH3 + OH -> H2O + NHDEP rate = 1.70E-12*exp( -710./t) (335) + usr_HO2_aer (251) HO2 -> H2O rate = ** User defined ** (336) + usr_N2O5_aer (252) N2O5 -> 2*HNO3 rate = ** User defined ** (337) + usr_NH4_strat_ta (253) NH4 -> NHDEP rate = 6.34E-08 (338) + usr_NO2_aer (254) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (339) + usr_NO3_aer (255) NO3 -> HNO3 rate = ** User defined ** (340) + usr_ONITR_aer (256) ONITR -> HNO3 rate = ** User defined ** (341) + SOAE_tau (257) SOAE -> SOAG rate = 1.16E-05 (342) + het1 (258) N2O5 -> 2*HNO3 rate = ** User defined ** (343) + het10 (259) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (344) + het11 (260) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (345) + het12 (261) N2O5 -> 2*HNO3 rate = ** User defined ** (346) + het13 (262) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (347) + het14 (263) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (348) + het15 (264) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (349) + het16 (265) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (350) + het17 (266) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (351) + het2 (267) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (352) + het3 (268) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (353) + het4 (269) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (354) + het5 (270) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (355) + het6 (271) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (356) + het7 (272) N2O5 -> 2*HNO3 rate = ** User defined ** (357) + het8 (273) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (358) + het9 (274) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (359) + E90_tau (275) E90 -> {sink} rate = 1.29E-07 (360) + NH_50_tau (276) NH_50 -> (No products) rate = 2.31E-07 (361) + NH_5_tau (277) NH_5 -> (No products) rate = 2.31E-06 (362) + ST80_25_tau (278) ST80_25 -> (No products) rate = 4.63E-07 (363) + +Extraneous prod/loss species + ( 1) NO2 (dataset) + ( 2) so4_a2 (dataset) + ( 3) SO2 (dataset) + ( 4) so4_a1 (dataset) + ( 5) num_a2 (dataset) + ( 6) num_a1 (dataset) + ( 7) bc_a4 (dataset) + ( 8) num_a4 (dataset) + ( 9) NO + + + Equation Report + + d(bc_a1)/dt = 0 + d(bc_a4)/dt = 0 + d(BIGALK)/dt = - r208*OH*BIGALK + d(BR)/dt = j46*BRCL + j47*BRO + j49*BRONO2 + j51*CF2CLBR + j52*CF3BR + 2*j58*CH2BR2 + j59*CH3BR + + 3*j62*CHBR3 + 2*j68*H2402 + j69*HBR + j75*HOBR + r78*O1D*CF2CLBR + 2*r91*BRO*BRO + r92*BRO*CLO + + r93*BRO*CLO + r96*BRO*NO + r99*BRO*O + r100*BRO*OH + r101*HBR*O + r102*HBR*OH + r104*O1D*CF3BR + + 3*r105*O1D*CHBR3 + 2*r106*O1D*H2402 + r107*O1D*HBR + 2*r109*CH2BR2*CL + 2*r110*CH2BR2*OH + + r111*CH3BR*CL + r112*CH3BR*OH + 3*r116*CHBR3*CL + 3*r117*CHBR3*OH + 2*r121*O1D*CH2BR2 + + r122*O1D*CH3BR + r240*SO*BRO + - r88*CH2O*BR - r89*HO2*BR - r90*O3*BR + d(BRCL)/dt = r94*BRO*CLO + r266*HOBR*HCL + r271*HOBR*HCL + - j46*BRCL + d(BRO)/dt = j48*BRONO2 + r90*BR*O3 + r98*BRONO2*O + r103*HOBR*O + r108*O1D*HBR + - j47*BRO - 2*r91*BRO*BRO - r92*CLO*BRO - r93*CLO*BRO - r94*CLO*BRO - r95*HO2*BRO - r96*NO*BRO + - r97*M*NO2*BRO - r99*O*BRO - r100*OH*BRO - r240*SO*BRO + d(BRONO2)/dt = r97*M*BRO*NO2 + - j48*BRONO2 - j49*BRONO2 - r260*BRONO2 - r263*BRONO2 - r268*BRONO2 - r98*O*BRONO2 + d(BRY)/dt = 0 + d(C2H4)/dt = - r140*M*CL*C2H4 - r141*O3*C2H4 - r165*M*OH*C2H4 + d(C2H5OH)/dt = .4*r142*C2H5O2*C2H5O2 + .2*r143*C2H5O2*CH3O2 + - r146*OH*C2H5OH + d(C2H5OOH)/dt = r144*C2H5O2*HO2 + - j19*C2H5OOH - r147*OH*C2H5OOH + d(C2H6)/dt = - r148*CL*C2H6 - r149*OH*C2H6 + d(C3H6)/dt = .7*j39*MVK + .13*r219*ISOP*O3 + - r168*NO3*C3H6 - r169*O3*C3H6 - r186*M*OH*C3H6 + d(C3H7OOH)/dt = r171*C3H7O2*HO2 + - j20*C3H7OOH - r173*OH*C3H7OOH + d(C3H8)/dt = - r174*OH*C3H8 + d(CCL4)/dt = - j50*CCL4 - r77*O1D*CCL4 + d(CF2CLBR)/dt = - j51*CF2CLBR - r78*O1D*CF2CLBR + d(CF3BR)/dt = - j52*CF3BR - r104*O1D*CF3BR + d(CFC11)/dt = - j53*CFC11 - r79*O1D*CFC11 + d(CFC113)/dt = - j54*CFC113 - r80*O1D*CFC113 + d(CFC114)/dt = - j55*CFC114 - r81*O1D*CFC114 + d(CFC115)/dt = - j56*CFC115 - r82*O1D*CFC115 + d(CFC12)/dt = - j57*CFC12 - r83*O1D*CFC12 + d(CH2BR2)/dt = - j58*CH2BR2 - r109*CL*CH2BR2 - r110*OH*CH2BR2 - r121*O1D*CH2BR2 + d(CH2O)/dt = j27*CH3OOH + .18*j28*CH4 + j32*GLYALD + j34*HYAC + .69*j35*ISOPOOH + 1.34*j36*MACR + j40*NOA + + j41*ONITR + j43*POOH + j44*ROOH + 2*r160*EO + r59*CLO*CH3O2 + 2*r129*CH3O2*CH3O2 + + r130*CH3O2*CH3O2 + r132*CH3O2*NO + r133*CH3OH*OH + .3*r134*CH3OOH*OH + r137*O1D*CH4 + + r138*O1D*CH4 + r141*C2H4*O3 + .7*r143*C2H5O2*CH3O2 + r153*CH3CO3*CH3O2 + .5*r157*CH3COOOH*OH + + .5*r159*EO2*NO + .8*r162*GLYALD*OH + r164*PAN*OH + .5*r169*C3H6*O3 + r170*C3H7O2*CH3O2 + + r180*PO2*NO + .8*r182*RO2*CH3O2 + .15*r183*RO2*HO2 + r184*RO2*NO + .25*r188*MACRO2*CH3CO3 + + .88*r189*MACRO2*CH3O2 + .25*r191*MACRO2*NO3 + .25*r192*MACRO2*NO + .12*r194*MACR*O3 + + r197*MCO3*CH3CO3 + 2*r198*MCO3*CH3O2 + .45*r199*MCO3*HO2 + 2*r200*MCO3*MCO3 + r201*MCO3*NO + + r202*MCO3*NO3 + .5*r203*M*MPAN*OH + .6*r204*MVK*O3 + .206*r211*ISOPNO3*HO2 + + .072*r212*ISOPNO3*NO + .072*r213*ISOPNO3*NO3 + .6*r214*ISOPO2*CH3CO3 + 1.2*r215*ISOPO2*CH3O2 + + .55*r217*ISOPO2*NO + .6*r218*ISOPO2*NO3 + .91*r219*ISOP*O3 + .25*r224*XO2*CH3CO3 + + .8*r225*XO2*CH3O2 + .25*r227*XO2*NO + - j21*CH2O - j22*CH2O - r52*CL*CH2O - r88*BR*CH2O - r126*NO3*CH2O - r127*O*CH2O - r128*OH*CH2O + d(CH3BR)/dt = - j59*CH3BR - r111*CL*CH3BR - r112*OH*CH3BR - r122*O1D*CH3BR + d(CH3CCL3)/dt = - j60*CH3CCL3 - r113*OH*CH3CCL3 + d(CH3CHO)/dt = j19*C2H5OOH + j43*POOH + 1.6*r142*C2H5O2*C2H5O2 + .8*r143*C2H5O2*CH3O2 + r145*C2H5O2*NO + + r146*C2H5OH*OH + .5*r147*C2H5OOH*OH + .5*r169*C3H6*O3 + .27*r172*C3H7O2*NO + r180*PO2*NO + + .1*r204*MVK*O3 + - j23*CH3CHO - r150*NO3*CH3CHO - r151*OH*CH3CHO + d(CH3CL)/dt = - j61*CH3CL - r114*CL*CH3CL - r115*OH*CH3CL + d(CH3COCH3)/dt = .82*j20*C3H7OOH + .82*r170*C3H7O2*CH3O2 + .82*r172*C3H7O2*NO + .1*r232*TERP*OH + - j24*CH3COCH3 - r187*OH*CH3COCH3 + d(CH3COCHO)/dt = r177*HYAC*OH + r178*NOA*OH + .5*r182*RO2*CH3O2 + .25*r188*MACRO2*CH3CO3 + + .24*r189*MACRO2*CH3O2 + .25*r191*MACRO2*NO3 + .25*r192*MACRO2*NO + .88*r194*MACR*O3 + + .5*r204*MVK*O3 + .02*r217*ISOPO2*NO + .25*r224*XO2*CH3CO3 + .1*r225*XO2*CH3O2 + + .25*r227*XO2*NO + .25*r228*XO2*NO3 + - j25*CH3COCHO - r175*NO3*CH3COCHO - r176*OH*CH3COCHO + d(CH3COOH)/dt = .1*r153*CH3CO3*CH3O2 + .15*r154*CH3CO3*HO2 + .12*r169*C3H6*O3 + .15*r199*MCO3*HO2 + - r156*OH*CH3COOH + d(CH3COOOH)/dt = .4*r154*CH3CO3*HO2 + .4*r199*MCO3*HO2 + - j26*CH3COOOH - r157*OH*CH3COOOH + d(CH3OH)/dt = r130*CH3O2*CH3O2 + .3*r143*C2H5O2*CH3O2 + .5*r182*RO2*CH3O2 + .25*r189*MACRO2*CH3O2 + + .25*r215*ISOPO2*CH3O2 + .3*r225*XO2*CH3O2 + - r133*OH*CH3OH + d(CH3OOH)/dt = r131*CH3O2*HO2 + - j27*CH3OOH - r134*OH*CH3OOH + d(CH4)/dt = .1*r169*C3H6*O3 + - j28*CH4 - j29*CH4 - r53*CL*CH4 - r135*OH*CH4 - r136*O1D*CH4 - r137*O1D*CH4 - r138*O1D*CH4 + d(CHBR3)/dt = - j62*CHBR3 - r105*O1D*CHBR3 - r116*CL*CHBR3 - r117*OH*CHBR3 + d(CL)/dt = j46*BRCL + 4*j50*CCL4 + j51*CF2CLBR + 3*j53*CFC11 + 3*j54*CFC113 + 2*j55*CFC114 + j56*CFC115 + + 2*j57*CFC12 + 3*j60*CH3CCL3 + j61*CH3CL + 2*j63*CL2 + 2*j64*CL2O2 + j65*CLO + j67*CLONO2 + + j70*HCFC141B + j71*HCFC142B + j72*HCFC22 + j73*HCL + j76*HOCL + r59*CLO*CH3O2 + 2*r60*CLO*CLO + + r62*CLO*CLO + r64*CLO*NO + r69*CLO*O + r70*CLO*OH + r72*HCL*O + r73*HCL*OH + 4*r77*O1D*CCL4 + + r78*O1D*CF2CLBR + 3*r79*O1D*CFC11 + 3*r80*O1D*CFC113 + 2*r81*O1D*CFC114 + r82*O1D*CFC115 + + 2*r83*O1D*CFC12 + r84*O1D*HCL + r93*BRO*CLO + 3*r113*CH3CCL3*OH + r115*CH3CL*OH + + r118*HCFC141B*OH + r118*HCFC141B*OH + r119*HCFC142B*OH + r120*HCFC22*OH + r123*O1D*HCFC141B + + r123*O1D*HCFC141B + r124*O1D*HCFC142B + r125*O1D*HCFC22 + r241*SO*CLO + - r52*CH2O*CL - r53*CH4*CL - r54*H2*CL - r55*H2O2*CL - r56*HO2*CL - r57*HO2*CL - r58*O3*CL + - r65*CLONO2*CL - r74*HOCL*CL - r109*CH2BR2*CL - r111*CH3BR*CL - r114*CH3CL*CL - r116*CHBR3*CL + - r148*C2H6*CL + d(CL2)/dt = r61*CLO*CLO + r65*CLONO2*CL + r259*HOCL*HCL + r264*CLONO2*HCL + r265*HOCL*HCL + r269*CLONO2*HCL + + r270*HOCL*HCL + r274*CLONO2*HCL + - j63*CL2 + d(CL2O2)/dt = r86*M*CLO*CLO + - j64*CL2O2 - r87*M*CL2O2 + d(CLO)/dt = j66*CLONO2 + j77*OCLO + r87*M*CL2O2 + r87*M*CL2O2 + r57*CL*HO2 + r58*CL*O3 + r67*CLONO2*O + + r74*HOCL*CL + r75*HOCL*O + r76*HOCL*OH + r85*O1D*HCL + r246*SO*OCLO + - j65*CLO - r59*CH3O2*CLO - 2*r60*CLO*CLO - 2*r61*CLO*CLO - 2*r62*CLO*CLO - r63*HO2*CLO + - r64*NO*CLO - r66*M*NO2*CLO - r69*O*CLO - r70*OH*CLO - r71*OH*CLO - 2*r86*M*CLO*CLO + - r92*BRO*CLO - r93*BRO*CLO - r94*BRO*CLO - r241*SO*CLO + d(CLONO2)/dt = r66*M*CLO*NO2 + - j66*CLONO2 - j67*CLONO2 - r262*CLONO2 - r267*CLONO2 - r273*CLONO2 - r65*CL*CLONO2 + - r67*O*CLONO2 - r68*OH*CLONO2 - r264*HCL*CLONO2 - r269*HCL*CLONO2 - r274*HCL*CLONO2 + d(CLY)/dt = 0 + d(CO)/dt = j21*CH2O + j22*CH2O + j23*CH3CHO + j25*CH3COCHO + .38*j28*CH4 + j30*CO2 + j32*GLYALD + + 2*j33*GLYOXAL + 1.34*j37*MACR + .7*j39*MVK + j41*ONITR + j80*OCS + r52*CL*CH2O + r88*BR*CH2O + + r114*CH3CL*CL + r126*CH2O*NO3 + r127*CH2O*O + r128*CH2O*OH + .63*r141*C2H4*O3 + r163*GLYOXAL*OH + + .56*r169*C3H6*O3 + r175*CH3COCHO*NO3 + r176*CH3COCHO*OH + .22*r188*MACRO2*CH3CO3 + + .11*r189*MACRO2*CH3O2 + .22*r191*MACRO2*NO3 + .22*r192*MACRO2*NO + .65*r194*MACR*O3 + + .56*r204*MVK*O3 + .62*r219*ISOP*O3 + .25*r224*XO2*CH3CO3 + .2*r225*XO2*CH3O2 + .25*r227*XO2*NO + + .5*r228*XO2*NO3 + r235*OCS*O + r236*OCS*OH + - r139*OH*CO + d(CO2)/dt = j26*CH3COOOH + .44*j28*CH4 + .4*j42*PAN + r139*CO*OH + 2*r152*CH3CO3*CH3CO3 + + .9*r153*CH3CO3*CH3O2 + r155*CH3CO3*NO + r156*CH3COOH*OH + .5*r157*CH3COOOH*OH + + .8*r162*GLYALD*OH + r163*GLYOXAL*OH + .2*r169*C3H6*O3 + 2*r197*MCO3*CH3CO3 + r198*MCO3*CH3O2 + + .45*r199*MCO3*HO2 + 2*r200*MCO3*MCO3 + .5*r203*M*MPAN*OH + .1*r204*MVK*O3 + r224*XO2*CH3CO3 + - j30*CO2 + d(DMS)/dt = - r233*NO3*DMS - r234*OH*DMS - r248*OH*DMS + d(dst_a1)/dt = 0 + d(dst_a2)/dt = 0 + d(dst_a3)/dt = 0 + d(E90)/dt = - r275*E90 + d(EOOH)/dt = r158*EO2*HO2 + - j31*EOOH + d(GLYALD)/dt = r161*O2*EO + .53*r188*MACRO2*CH3CO3 + .26*r189*MACRO2*CH3O2 + .53*r191*MACRO2*NO3 + + .53*r192*MACRO2*NO + .02*r217*ISOPO2*NO + .25*r224*XO2*CH3CO3 + .1*r225*XO2*CH3O2 + + .25*r227*XO2*NO + .25*r228*XO2*NO3 + - j32*GLYALD - r162*OH*GLYALD + d(GLYOXAL)/dt = .2*r162*GLYALD*OH + .02*r217*ISOPO2*NO + .25*r224*XO2*CH3CO3 + .1*r225*XO2*CH3O2 + + .25*r227*XO2*NO + .25*r228*XO2*NO3 + - j33*GLYOXAL - r163*OH*GLYOXAL + d(H)/dt = j2*H2O + 2*j3*H2O + 2*j21*CH2O + j27*CH3OOH + .33*j28*CH4 + j29*CH4 + j69*HBR + j73*HCL + j74*HF + + r1*O1D*H2 + r10*H2*O + r19*OH*H2 + r22*OH*O + r40*N*OH + r54*CL*H2 + r85*O1D*HCL + + r108*O1D*HBR + r128*CH2O*OH + r137*O1D*CH4 + r236*OCS*OH + r242*S*OH + r247*SO*OH + - r15*O2*M*H - r12*HO2*H - r13*HO2*H - r14*HO2*H - r18*O3*H + d(H2)/dt = j1*H2O + j22*CH2O + 1.4400001*j28*CH4 + r12*H*HO2 + r138*O1D*CH4 + - r1*O1D*H2 - r10*O*H2 - r19*OH*H2 - r54*CL*H2 + d(H2402)/dt = - j68*H2402 - r106*O1D*H2402 + d(H2O2)/dt = r25*M*OH*OH + r26*HO2*HO2 + - j4*H2O2 - r11*O*H2O2 - r20*OH*H2O2 - r55*CL*H2O2 + d(H2SO4)/dt = r249*SO3*H2O + - j79*H2SO4 + d(HBR)/dt = r88*BR*CH2O + r89*BR*HO2 + - j69*HBR - r101*O*HBR - r102*OH*HBR - r107*O1D*HBR - r108*O1D*HBR + d(HCFC141B)/dt = - j70*HCFC141B - r118*OH*HCFC141B - r123*O1D*HCFC141B + d(HCFC142B)/dt = - j71*HCFC142B - r119*OH*HCFC142B - r124*O1D*HCFC142B + d(HCFC22)/dt = - j72*HCFC22 - r120*OH*HCFC22 - r125*O1D*HCFC22 + d(HCL)/dt = r52*CL*CH2O + r53*CL*CH4 + r54*CL*H2 + r55*CL*H2O2 + r56*CL*HO2 + r71*CLO*OH + r74*HOCL*CL + + r109*CH2BR2*CL + r111*CH3BR*CL + 2*r114*CH3CL*CL + r116*CHBR3*CL + r148*C2H6*CL + - j73*HCL - r72*O*HCL - r73*OH*HCL - r84*O1D*HCL - r85*O1D*HCL - r259*HOCL*HCL + - r264*CLONO2*HCL - r265*HOCL*HCL - r266*HOBR*HCL - r269*CLONO2*HCL - r270*HOCL*HCL + - r271*HOBR*HCL - r274*CLONO2*HCL + d(HF)/dt = - j74*HF + d(HNO3)/dt = 2*r252*N2O5 + .5*r254*NO2 + r255*NO3 + r256*ONITR + 2*r258*N2O5 + r260*BRONO2 + 2*r261*N2O5 + + r262*CLONO2 + r263*BRONO2 + r267*CLONO2 + r268*BRONO2 + 2*r272*N2O5 + r273*CLONO2 + + r48*M*NO2*OH + r126*CH2O*NO3 + r150*CH3CHO*NO3 + r175*CH3COCHO*NO3 + r233*DMS*NO3 + + r264*CLONO2*HCL + r269*CLONO2*HCL + r274*CLONO2*HCL + - j9*HNO3 - r49*OH*HNO3 + d(HO2NO2)/dt = r46*M*NO2*HO2 + - j10*HO2NO2 - j11*HO2NO2 - r50*M*HO2NO2 - r27*OH*HO2NO2 + d(HOBR)/dt = r260*BRONO2 + r263*BRONO2 + r268*BRONO2 + r95*BRO*HO2 + - j75*HOBR - r103*O*HOBR - r266*HCL*HOBR - r271*HCL*HOBR + d(HOCL)/dt = r262*CLONO2 + r267*CLONO2 + r273*CLONO2 + r63*CLO*HO2 + r68*CLONO2*OH + - j76*HOCL - r74*CL*HOCL - r75*O*HOCL - r76*OH*HOCL - r259*HCL*HOCL - r265*HCL*HOCL + - r270*HCL*HOCL + d(HYAC)/dt = .5*r181*POOH*OH + .2*r182*RO2*CH3O2 + .22*r188*MACRO2*CH3CO3 + .23*r189*MACRO2*CH3O2 + + .22*r191*MACRO2*NO3 + .22*r192*MACRO2*NO + .5*r203*M*MPAN*OH + .02*r217*ISOPO2*NO + + .25*r224*XO2*CH3CO3 + .1*r225*XO2*CH3O2 + .25*r227*XO2*NO + .25*r228*XO2*NO3 + - j34*HYAC - r177*OH*HYAC + d(HYDRALD)/dt = .4*r214*ISOPO2*CH3CO3 + .3*r215*ISOPO2*CH3O2 + .33*r217*ISOPO2*NO + .4*r218*ISOPO2*NO3 + + r222*ONITR*NO3 + r223*ONITR*OH + - r209*OH*HYDRALD + d(ISOP)/dt = - r210*NO3*ISOP - r219*O3*ISOP - r220*OH*ISOP + d(ISOPNO3)/dt = r210*ISOP*NO3 + - r211*HO2*ISOPNO3 - r212*NO*ISOPNO3 - r213*NO3*ISOPNO3 + d(ISOPOOH)/dt = r216*ISOPO2*HO2 + - j35*ISOPOOH - r221*OH*ISOPOOH + d(MACR)/dt = .288*j35*ISOPOOH + .167*r211*ISOPNO3*HO2 + .167*r212*ISOPNO3*NO + .167*r213*ISOPNO3*NO3 + + .25*r214*ISOPO2*CH3CO3 + .19*r215*ISOPO2*CH3O2 + .23*r217*ISOPO2*NO + .25*r218*ISOPO2*NO3 + + .3*r219*ISOP*O3 + 1.122*r231*TERP*O3 + - j36*MACR - j37*MACR - r194*O3*MACR - r195*OH*MACR + d(MACROOH)/dt = r190*MACRO2*HO2 + - r196*OH*MACROOH + d(MPAN)/dt = r206*M*MCO3*NO2 + - j38*MPAN - r207*M*MPAN - r203*M*OH*MPAN + d(MVK)/dt = .402*j35*ISOPOOH + .039*r211*ISOPNO3*HO2 + .039*r212*ISOPNO3*NO + .039*r213*ISOPNO3*NO3 + + .35*r214*ISOPO2*CH3CO3 + .26*r215*ISOPO2*CH3O2 + .32*r217*ISOPO2*NO + .35*r218*ISOPO2*NO3 + + .2*r219*ISOP*O3 + .442*r231*TERP*O3 + - j39*MVK - r204*O3*MVK - r205*OH*MVK + d(N)/dt = j15*NO + - r32*O2*N - r28*NO*N - r29*NO2*N - r30*NO2*N - r31*NO2*N - r40*OH*N + d(N2O)/dt = r29*N*NO2 + - j12*N2O - r44*O1D*N2O - r45*O1D*N2O + d(N2O5)/dt = r47*M*NO2*NO3 + - j13*N2O5 - j14*N2O5 - r51*M*N2O5 - r252*N2O5 - r258*N2O5 - r261*N2O5 - r272*N2O5 + d(ncl_a1)/dt = 0 + d(ncl_a2)/dt = 0 + d(ncl_a3)/dt = 0 + d(NH3)/dt = - r250*OH*NH3 + d(NH4)/dt = - r253*NH4 + d(NH_5)/dt = - r277*NH_5 + d(NH_50)/dt = - r276*NH_50 + d(NO)/dt = j14*N2O5 + j16*NO2 + j17*NO3 + r32*O2*N + .5*r254*NO2 + 2*r30*N*NO2 + r33*NO2*O + r40*N*OH + + 2*r44*O1D*N2O + r243*SO*NO2 + - j15*NO - r28*N*NO - r37*NO3*NO - r41*HO2*NO - r42*O3*NO - r43*M*O*NO - r64*CLO*NO + - r96*BRO*NO - r132*CH3O2*NO - r145*C2H5O2*NO - r155*CH3CO3*NO - r159*EO2*NO - r172*C3H7O2*NO + - r180*PO2*NO - r184*RO2*NO - r192*MACRO2*NO - r193*MACRO2*NO - r201*MCO3*NO - r212*ISOPNO3*NO + - r217*ISOPO2*NO - r227*XO2*NO + d(NO2)/dt = j9*HNO3 + j11*HO2NO2 + j13*N2O5 + j18*NO3 + j38*MPAN + j40*NOA + j41*ONITR + .6*j42*PAN + + j48*BRONO2 + j66*CLONO2 + r50*M*HO2NO2 + r51*M*N2O5 + r167*M*PAN + r207*M*MPAN + + r27*HO2NO2*OH + r36*NO3*HO2 + 2*r37*NO3*NO + r38*NO3*O + r39*NO3*OH + r41*NO*HO2 + r42*NO*O3 + + r43*M*NO*O + r64*CLO*NO + r96*BRO*NO + r132*CH3O2*NO + r145*C2H5O2*NO + r155*CH3CO3*NO + + r159*EO2*NO + r172*C3H7O2*NO + r178*NOA*OH + r180*PO2*NO + r184*RO2*NO + r191*MACRO2*NO3 + + r192*MACRO2*NO + r201*MCO3*NO + r202*MCO3*NO3 + .206*r211*ISOPNO3*HO2 + 1.206*r212*ISOPNO3*NO + + 1.206*r213*ISOPNO3*NO3 + .92*r217*ISOPO2*NO + r218*ISOPO2*NO3 + r222*ONITR*NO3 + + .4*r223*ONITR*OH + r227*XO2*NO + r228*XO2*NO3 + r230*TERP*NO3 + - j16*NO2 - r254*NO2 - r29*N*NO2 - r30*N*NO2 - r31*N*NO2 - r33*O*NO2 - r34*O3*NO2 + - r35*M*O*NO2 - r46*M*HO2*NO2 - r47*M*NO3*NO2 - r48*M*OH*NO2 - r66*M*CLO*NO2 - r97*M*BRO*NO2 + - r166*M*CH3CO3*NO2 - r206*M*MCO3*NO2 - r243*SO*NO2 + d(NO3)/dt = j10*HO2NO2 + j13*N2O5 + j14*N2O5 + .4*j42*PAN + j49*BRONO2 + j67*CLONO2 + r51*M*N2O5 + + r34*NO2*O3 + r35*M*NO2*O + r49*HNO3*OH + r65*CLONO2*CL + r67*CLONO2*O + r68*CLONO2*OH + + r98*BRONO2*O + r164*PAN*OH + .5*r203*M*MPAN*OH + - j17*NO3 - j18*NO3 - r255*NO3 - r36*HO2*NO3 - r37*NO*NO3 - r38*O*NO3 - r39*OH*NO3 + - r47*M*NO2*NO3 - r126*CH2O*NO3 - r150*CH3CHO*NO3 - r168*C3H6*NO3 - r175*CH3COCHO*NO3 + - r191*MACRO2*NO3 - r202*MCO3*NO3 - r210*ISOP*NO3 - r213*ISOPNO3*NO3 - r218*ISOPO2*NO3 + - r222*ONITR*NO3 - r228*XO2*NO3 - r230*TERP*NO3 - r233*DMS*NO3 + d(NOA)/dt = r168*C3H6*NO3 + - j40*NOA - r178*OH*NOA + d(num_a1)/dt = 0 + d(num_a2)/dt = 0 + d(num_a3)/dt = 0 + d(num_a4)/dt = 0 + d(num_a5)/dt = 0 + d(O)/dt = j5*O2 + 2*j6*O2 + j3*H2O + j8*O3 + j14*N2O5 + j15*NO + j16*NO2 + j18*NO3 + .18*j28*CH4 + + j30*CO2 + j47*BRO + j65*CLO + j77*OCLO + j81*SO + j82*SO2 + j83*SO3 + r3*N2*O1D + r4*O2*O1D + + r32*O2*N + r237*O2*S + r244*O2*SO + 2*r6*O1D*O3 + r14*H*HO2 + r24*OH*OH + r28*N*NO + r29*N*NO2 + + .765*r231*TERP*O3 + - r9*O2*M*O - r7*O3*O - 2*r8*M*O*O - r10*H2*O - r11*H2O2*O - r16*HO2*O - r22*OH*O - r33*NO2*O + - r35*M*NO2*O - r38*NO3*O - r43*M*NO*O - r67*CLONO2*O - r69*CLO*O - r72*HCL*O - r75*HOCL*O + - r98*BRONO2*O - r99*BRO*O - r101*HBR*O - r103*HOBR*O - r127*CH2O*O - r235*OCS*O + d(O3)/dt = r9*O2*M*O + .15*r154*CH3CO3*HO2 + .15*r199*MCO3*HO2 + - j7*O3 - j8*O3 - r5*O1D*O3 - r6*O1D*O3 - r7*O*O3 - r17*HO2*O3 - r18*H*O3 - r23*OH*O3 + - r34*NO2*O3 - r42*NO*O3 - r58*CL*O3 - r90*BR*O3 - r141*C2H4*O3 - r169*C3H6*O3 - r194*MACR*O3 + - r204*MVK*O3 - r219*ISOP*O3 - r231*TERP*O3 - r239*S*O3 - r245*SO*O3 + d(O3S)/dt = 0 + d(OCLO)/dt = r62*CLO*CLO + r92*BRO*CLO + - j77*OCLO - r246*SO*OCLO + d(OCS)/dt = - j80*OCS - r235*O*OCS - r236*OH*OCS + d(ONITR)/dt = .8*r193*MACRO2*NO + .794*r211*ISOPNO3*HO2 + .794*r212*ISOPNO3*NO + .794*r213*ISOPNO3*NO3 + + .08*r217*ISOPO2*NO + - j41*ONITR - r256*ONITR - r222*NO3*ONITR - r223*OH*ONITR + d(PAN)/dt = r166*M*CH3CO3*NO2 + - j42*PAN - r167*M*PAN - r164*OH*PAN + d(pom_a1)/dt = 0 + d(pom_a4)/dt = 0 + d(POOH)/dt = r179*PO2*HO2 + - j43*POOH - r181*OH*POOH + d(ROOH)/dt = .85*r183*RO2*HO2 + - j44*ROOH - r185*OH*ROOH + d(S)/dt = j80*OCS + j81*SO + - r237*O2*S - r239*O3*S - r242*OH*S + d(SF6)/dt = - j78*SF6 + d(SO)/dt = j82*SO2 + r237*O2*S + r235*OCS*O + r239*S*O3 + r242*S*OH + - j81*SO - r244*O2*SO - r240*BRO*SO - r241*CLO*SO - r243*NO2*SO - r245*O3*SO - r246*OCLO*SO + - r247*OH*SO + d(SO2)/dt = j83*SO3 + r244*O2*SO + r233*DMS*NO3 + r234*DMS*OH + r236*OCS*OH + r240*SO*BRO + r241*SO*CLO + + r243*SO*NO2 + r245*SO*O3 + r246*SO*OCLO + r247*SO*OH + .5*r248*DMS*OH + - j82*SO2 - r238*M*OH*SO2 + d(SO3)/dt = j79*H2SO4 + r238*M*SO2*OH + - j83*SO3 - r249*H2O*SO3 + d(so4_a1)/dt = 0 + d(so4_a2)/dt = 0 + d(so4_a3)/dt = 0 + d(so4_a5)/dt = 0 + d(soa_a1)/dt = - j84*soa_a1 + d(soa_a2)/dt = - j85*soa_a2 + d(SOAE)/dt = - r257*SOAE + d(SOAG)/dt = r257*SOAE + d(ST80_25)/dt = - r278*ST80_25 + d(TERP)/dt = - r230*NO3*TERP - r231*O3*TERP - r232*OH*TERP + d(XOOH)/dt = r226*XO2*HO2 + - j45*XOOH - r229*OH*XOOH + d(NHDEP)/dt = r253*NH4 + r250*NH3*OH + d(NDEP)/dt = .5*r203*M*MPAN*OH + d(C2H5O2)/dt = .5*r147*C2H5OOH*OH + r148*C2H6*CL + r149*C2H6*OH + - 2*r142*C2H5O2*C2H5O2 - r143*CH3O2*C2H5O2 - r144*HO2*C2H5O2 - r145*NO*C2H5O2 + d(C3H7O2)/dt = r173*C3H7OOH*OH + r174*C3H8*OH + 1.67*r208*BIGALK*OH + - r170*CH3O2*C3H7O2 - r171*HO2*C3H7O2 - r172*NO*C3H7O2 + d(CH3CO3)/dt = j24*CH3COCH3 + j25*CH3COCHO + j34*HYAC + 1.34*j36*MACR + .3*j39*MVK + j40*NOA + .6*j42*PAN + + j44*ROOH + r167*M*PAN + r150*CH3CHO*NO3 + r151*CH3CHO*OH + .5*r157*CH3COOOH*OH + + r175*CH3COCHO*NO3 + r176*CH3COCHO*OH + .3*r182*RO2*CH3O2 + .15*r183*RO2*HO2 + r184*RO2*NO + + .53*r188*MACRO2*CH3CO3 + .26*r189*MACRO2*CH3O2 + .53*r191*MACRO2*NO3 + .53*r192*MACRO2*NO + + .1*r194*MACR*O3 + r198*MCO3*CH3O2 + .45*r199*MCO3*HO2 + 2*r200*MCO3*MCO3 + r201*MCO3*NO + + r202*MCO3*NO3 + .28*r204*MVK*O3 + .08*r219*ISOP*O3 + - 2*r152*CH3CO3*CH3CO3 - r153*CH3O2*CH3CO3 - r154*HO2*CH3CO3 - r155*NO*CH3CO3 + - r166*M*NO2*CH3CO3 - r188*MACRO2*CH3CO3 - r214*ISOPO2*CH3CO3 - r224*XO2*CH3CO3 + d(CH3O2)/dt = j23*CH3CHO + j24*CH3COCH3 + j26*CH3COOOH + j29*CH4 + .3*j39*MVK + .4*j42*PAN + j59*CH3BR + + j61*CH3CL + r53*CL*CH4 + .7*r134*CH3OOH*OH + r135*CH4*OH + r136*O1D*CH4 + + 2*r152*CH3CO3*CH3CO3 + .9*r153*CH3CO3*CH3O2 + .45*r154*CH3CO3*HO2 + r155*CH3CO3*NO + + r156*CH3COOH*OH + .28*r169*C3H6*O3 + r188*MACRO2*CH3CO3 + r197*MCO3*CH3CO3 + + r214*ISOPO2*CH3CO3 + .05*r219*ISOP*O3 + r224*XO2*CH3CO3 + - r59*CLO*CH3O2 - 2*r129*CH3O2*CH3O2 - 2*r130*CH3O2*CH3O2 - r131*HO2*CH3O2 - r132*NO*CH3O2 + - r143*C2H5O2*CH3O2 - r153*CH3CO3*CH3O2 - r170*C3H7O2*CH3O2 - r182*RO2*CH3O2 + - r189*MACRO2*CH3O2 - r198*MCO3*CH3O2 - r215*ISOPO2*CH3O2 - r225*XO2*CH3O2 + d(EO)/dt = j31*EOOH + .75*r159*EO2*NO + - r160*EO - r161*O2*EO + d(EO2)/dt = r165*M*C2H4*OH + - r158*HO2*EO2 - r159*NO*EO2 + d(HO2)/dt = j11*HO2NO2 + j19*C2H5OOH + j20*C3H7OOH + j23*CH3CHO + j25*CH3COCHO + 2*j32*GLYALD + + 2*j33*GLYOXAL + j34*HYAC + j35*ISOPOOH + 1.34*j36*MACR + .66*j37*MACR + j41*ONITR + j43*POOH + + r15*O2*M*H + r50*M*HO2NO2 + r160*EO + r161*O2*EO + r11*H2O2*O + r20*OH*H2O2 + r23*OH*O3 + + r39*NO3*OH + r52*CL*CH2O + r55*CL*H2O2 + r59*CLO*CH3O2 + r70*CLO*OH + r88*BR*CH2O + + r100*BRO*OH + r111*CH3BR*CL + r112*CH3BR*OH + r114*CH3CL*CL + r115*CH3CL*OH + r126*CH2O*NO3 + + r127*CH2O*O + 2*r129*CH3O2*CH3O2 + r132*CH3O2*NO + r133*CH3OH*OH + r137*O1D*CH4 + r139*CO*OH + + .13*r141*C2H4*O3 + 1.2*r142*C2H5O2*C2H5O2 + r143*C2H5O2*CH3O2 + r145*C2H5O2*NO + r146*C2H5OH*OH + + .9*r153*CH3CO3*CH3O2 + .25*r159*EO2*NO + r162*GLYALD*OH + r163*GLYOXAL*OH + .28*r169*C3H6*O3 + + r170*C3H7O2*CH3O2 + r172*C3H7O2*NO + r177*HYAC*OH + r180*PO2*NO + .3*r182*RO2*CH3O2 + + .47*r188*MACRO2*CH3CO3 + .73*r189*MACRO2*CH3O2 + .47*r191*MACRO2*NO3 + .47*r192*MACRO2*NO + + .14*r194*MACR*O3 + .2*r196*MACROOH*OH + r198*MCO3*CH3O2 + .5*r203*M*MPAN*OH + .28*r204*MVK*O3 + + .794*r212*ISOPNO3*NO + .794*r213*ISOPNO3*NO3 + r214*ISOPO2*CH3CO3 + r215*ISOPO2*CH3O2 + + .92*r217*ISOPO2*NO + r218*ISOPO2*NO3 + .37*r219*ISOP*O3 + r222*ONITR*NO3 + r223*ONITR*OH + + r224*XO2*CH3CO3 + .8*r225*XO2*CH3O2 + r227*XO2*NO + r228*XO2*NO3 + r238*M*SO2*OH + + .5*r248*DMS*OH + - r251*HO2 - r12*H*HO2 - r13*H*HO2 - r14*H*HO2 - r16*O*HO2 - r17*O3*HO2 - r21*OH*HO2 + - 2*r26*HO2*HO2 - r36*NO3*HO2 - r41*NO*HO2 - r46*M*NO2*HO2 - r56*CL*HO2 - r57*CL*HO2 + - r63*CLO*HO2 - r89*BR*HO2 - r95*BRO*HO2 - r131*CH3O2*HO2 - r144*C2H5O2*HO2 - r154*CH3CO3*HO2 + - r158*EO2*HO2 - r171*C3H7O2*HO2 - r179*PO2*HO2 - r183*RO2*HO2 - r190*MACRO2*HO2 - r199*MCO3*HO2 + - r211*ISOPNO3*HO2 - r216*ISOPO2*HO2 - r226*XO2*HO2 + d(ISOPO2)/dt = r220*ISOP*OH + .2*r221*ISOPOOH*OH + 1.7*r230*TERP*NO3 + 1.64*r232*TERP*OH + - r214*CH3CO3*ISOPO2 - r215*CH3O2*ISOPO2 - r216*HO2*ISOPO2 - r217*NO*ISOPO2 - r218*NO3*ISOPO2 + d(MACRO2)/dt = .5*r195*MACR*OH + .2*r196*MACROOH*OH + r205*MVK*OH + - r188*CH3CO3*MACRO2 - r189*CH3O2*MACRO2 - r190*HO2*MACRO2 - r191*NO3*MACRO2 - r192*NO*MACRO2 + - r193*NO*MACRO2 + d(MCO3)/dt = .66*j36*MACR + j38*MPAN + r207*M*MPAN + .5*r195*MACR*OH + .5*r196*MACROOH*OH + - r197*CH3CO3*MCO3 - r198*CH3O2*MCO3 - r199*HO2*MCO3 - 2*r200*MCO3*MCO3 - r201*NO*MCO3 + - r202*NO3*MCO3 - r206*M*NO2*MCO3 + d(O1D)/dt = j5*O2 + j1*H2O + j7*O3 + j12*N2O + - r3*N2*O1D - r4*O2*O1D - r1*H2*O1D - r2*H2O*O1D - r5*O3*O1D - r6*O3*O1D - r44*N2O*O1D + - r45*N2O*O1D - r77*CCL4*O1D - r78*CF2CLBR*O1D - r79*CFC11*O1D - r80*CFC113*O1D - r81*CFC114*O1D + - r82*CFC115*O1D - r83*CFC12*O1D - r84*HCL*O1D - r85*HCL*O1D - r104*CF3BR*O1D - r105*CHBR3*O1D + - r106*H2402*O1D - r107*HBR*O1D - r108*HBR*O1D - r121*CH2BR2*O1D - r122*CH3BR*O1D + - r123*HCFC141B*O1D - r124*HCFC142B*O1D - r125*HCFC22*O1D - r136*CH4*O1D - r137*CH4*O1D + - r138*CH4*O1D + d(OH)/dt = j2*H2O + 2*j4*H2O2 + j9*HNO3 + j10*HO2NO2 + j19*C2H5OOH + j20*C3H7OOH + j26*CH3COOOH + + j27*CH3OOH + .33*j28*CH4 + j31*EOOH + j43*POOH + j44*ROOH + j45*XOOH + j75*HOBR + j76*HOCL + + .5*r254*NO2 + r1*O1D*H2 + 2*r2*O1D*H2O + r10*H2*O + r11*H2O2*O + 2*r13*H*HO2 + r16*HO2*O + + r17*HO2*O3 + r18*H*O3 + r36*NO3*HO2 + r41*NO*HO2 + r57*CL*HO2 + r72*HCL*O + r75*HOCL*O + + r84*O1D*HCL + r101*HBR*O + r103*HOBR*O + r107*O1D*HBR + r127*CH2O*O + .3*r134*CH3OOH*OH + + r136*O1D*CH4 + .13*r141*C2H4*O3 + .5*r147*C2H5OOH*OH + .45*r154*CH3CO3*HO2 + .36*r169*C3H6*O3 + + .5*r181*POOH*OH + .15*r183*RO2*HO2 + .24*r194*MACR*O3 + .1*r196*MACROOH*OH + .45*r199*MCO3*HO2 + + .36*r204*MVK*O3 + .206*r211*ISOPNO3*HO2 + .32*r219*ISOP*O3 + .5*r229*XOOH*OH + + 1.156*r231*TERP*O3 + - r19*H2*OH - r20*H2O2*OH - r21*HO2*OH - r22*O*OH - r23*O3*OH - 2*r24*OH*OH - 2*r25*M*OH*OH + - r27*HO2NO2*OH - r39*NO3*OH - r40*N*OH - r48*M*NO2*OH - r49*HNO3*OH - r68*CLONO2*OH + - r70*CLO*OH - r71*CLO*OH - r73*HCL*OH - r76*HOCL*OH - r100*BRO*OH - r102*HBR*OH + - r110*CH2BR2*OH - r112*CH3BR*OH - r113*CH3CCL3*OH - r115*CH3CL*OH - r117*CHBR3*OH + - r118*HCFC141B*OH - r119*HCFC142B*OH - r120*HCFC22*OH - r128*CH2O*OH - r133*CH3OH*OH + - r134*CH3OOH*OH - r135*CH4*OH - r139*CO*OH - r146*C2H5OH*OH - r147*C2H5OOH*OH - r149*C2H6*OH + - r151*CH3CHO*OH - r156*CH3COOH*OH - r157*CH3COOOH*OH - r162*GLYALD*OH - r163*GLYOXAL*OH + - r164*PAN*OH - r165*M*C2H4*OH - r173*C3H7OOH*OH - r174*C3H8*OH - r176*CH3COCHO*OH - r177*HYAC*OH + - r178*NOA*OH - r181*POOH*OH - r185*ROOH*OH - r186*M*C3H6*OH - r187*CH3COCH3*OH - r195*MACR*OH + - r196*MACROOH*OH - r203*M*MPAN*OH - r205*MVK*OH - r208*BIGALK*OH - r209*HYDRALD*OH + - r220*ISOP*OH - r221*ISOPOOH*OH - r223*ONITR*OH - r229*XOOH*OH - r232*TERP*OH - r234*DMS*OH + - r236*OCS*OH - r238*M*SO2*OH - r242*S*OH - r247*SO*OH - r248*DMS*OH - r250*NH3*OH + d(PO2)/dt = .5*r181*POOH*OH + r186*M*C3H6*OH + - r179*HO2*PO2 - r180*NO*PO2 + d(RO2)/dt = r185*ROOH*OH + r187*CH3COCH3*OH + - r182*CH3O2*RO2 - r183*HO2*RO2 - r184*NO*RO2 + d(XO2)/dt = r209*HYDRALD*OH + .8*r221*ISOPOOH*OH + .5*r229*XOOH*OH + - r224*CH3CO3*XO2 - r225*CH3O2*XO2 - r226*HO2*XO2 - r227*NO*XO2 - r228*NO3*XO2 + d(H2O)/dt = .05*j28*CH4 + j79*H2SO4 + r251*HO2 + r14*H*HO2 + r19*OH*H2 + r20*OH*H2O2 + r21*OH*HO2 + + r24*OH*OH + r27*HO2NO2*OH + r49*HNO3*OH + r73*HCL*OH + r76*HOCL*OH + r102*HBR*OH + + r110*CH2BR2*OH + r112*CH3BR*OH + r113*CH3CCL3*OH + r115*CH3CL*OH + r120*HCFC22*OH + + r128*CH2O*OH + r134*CH3OOH*OH + r135*CH4*OH + r149*C2H6*OH + r151*CH3CHO*OH + r156*CH3COOH*OH + + r157*CH3COOOH*OH + r173*C3H7OOH*OH + r174*C3H8*OH + r176*CH3COCHO*OH + r181*POOH*OH + + r185*ROOH*OH + r187*CH3COCH3*OH + .5*r195*MACR*OH + r250*NH3*OH + r259*HOCL*HCL + + r265*HOCL*HCL + r266*HOBR*HCL + r270*HOCL*HCL + r271*HOBR*HCL + - j1*H2O - j2*H2O - j3*H2O - r2*O1D*H2O - r249*SO3*H2O diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/chem_mech.in b/src/chemistry/pp_trop_strat_mam5_ts4/chem_mech.in new file mode 100644 index 0000000000..afc2928b01 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/chem_mech.in @@ -0,0 +1,804 @@ +* Comments +* User-given Tag Description: TS4-simpleSOA +* Tag database identifier : MZ331_TS4_20230410 +* Tag created by : lke +* Tag created from branch : TS4 +* Tag created on : 2023-04-10 17:47:58.117698-06 +* Comments for this tag follow: +* lke : 2023-04-10 : Reduced TS mechanism for climate simulations with new simple SOA scheme, with MAM5. + + SPECIES + + Solution + bc_a1 -> C, + bc_a4 -> C, + BIGALK -> C5H12, + BR -> Br, + BRCL -> BrCl, + BRO -> BrO, + BRONO2 -> BrONO2, + BRY, + C2H4, + C2H5OH, + C2H5OOH, + C2H6, + C3H6, + C3H7OOH, + C3H8, + CCL4 -> CCl4, + CF2CLBR -> CF2ClBr, + CF3BR -> CF3Br, + CFC11 -> CFCl3, + CFC113 -> CCl2FCClF2, + CFC114 -> CClF2CClF2, + CFC115 -> CClF2CF3, + CFC12 -> CF2Cl2, + CH2BR2 -> CH2Br2, + CH2O, + CH3BR -> CH3Br, + CH3CCL3 -> CH3CCl3, + CH3CHO, + CH3CL -> CH3Cl, + CH3COCH3, + CH3COCHO, + CH3COOH, + CH3COOOH, + CH3OH, + CH3OOH, + CH4, + CHBR3 -> CHBr3, + CL -> Cl, + CL2 -> Cl2, + CL2O2 -> Cl2O2, + CLO -> ClO, + CLONO2 -> ClONO2, + CLY, + CO, + CO2, + DMS -> CH3SCH3, + dst_a1 -> AlSiO5, + dst_a2 -> AlSiO5, + dst_a3 -> AlSiO5, + E90 -> CO, + EOOH -> HOCH2CH2OOH, + GLYALD -> HOCH2CHO, + GLYOXAL -> C2H2O2, + H, + H2, + H2402 -> CBrF2CBrF2, + H2O2, + H2SO4 -> H2SO4, + HBR -> HBr, + HCFC141B -> CH3CCl2F, + HCFC142B -> CH3CClF2, + HCFC22 -> CHF2Cl, + HCL -> HCl, + HF, + HNO3, + HO2NO2, + HOBR -> HOBr, + HOCL -> HOCl, + HYAC -> CH3COCH2OH, + HYDRALD -> HOCH2CCH3CHCHO, + ISOP -> C5H8, + ISOPNO3 -> CH2CHCCH3OOCH2ONO2, + ISOPOOH -> HOCH2COOHCH3CHCH2, + MACR -> CH2CCH3CHO, + MACROOH -> CH3COCHOOHCH2OH, + MPAN -> CH2CCH3CO3NO2, + MVK -> CH2CHCOCH3, + N, + N2O, + N2O5, + ncl_a1 -> NaCl, + ncl_a2 -> NaCl, + ncl_a3 -> NaCl, + NH3, + NH4, + NH_5 -> CO, + NH_50 -> CO, + NO, + NO2, + NO3, + NOA -> CH3COCH2ONO2, + num_a1 -> H, + num_a2 -> H, + num_a3 -> H, + num_a4 -> H, + num_a5 -> H, + O, + O3, + O3S -> O3, + OCLO -> OClO, + OCS -> OCS, + ONITR -> C4H7NO4, + PAN -> CH3CO3NO2, + pom_a1 -> C, + pom_a4 -> C, + POOH -> C3H6OHOOH, + ROOH -> CH3COCH2OOH, + S -> S, + SF6, + SO -> SO, + SO2, + SO3 -> SO3, + so4_a1 -> NH4HSO4, + so4_a2 -> NH4HSO4, + so4_a3 -> NH4HSO4, + so4_a5 -> NH4HSO4, + soa_a1 -> C, + soa_a2 -> C, + SOAE -> C, + SOAG -> C, + ST80_25 -> CO, + TERP -> C10H16, + XOOH -> HOCH2COOHCH3CHOHCHO, + NHDEP -> N, + NDEP -> N, + C2H5O2, + C3H7O2, + CH3CO3, + CH3O2, + EO -> HOCH2CH2O, + EO2 -> HOCH2CH2O2, + HO2, + ISOPO2 -> HOCH2COOCH3CHCH2, + MACRO2 -> CH3COCHO2CH2OH, + MCO3 -> CH2CCH3CO3, + O1D -> O, + OH, + PO2 -> C3H6OHO2, + RO2 -> CH3COCH2O2, + XO2 -> HOCH2COOCH3CHOHCHO, + H2O + + End Solution + + + Fixed + M, O2, N2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + Not-Transported + C2H5O2, + C3H7O2, + CH3CO3, + CH3O2, + EO, + EO2, + HO2, + ISOPO2, + MACRO2, + MCO3, + O1D, + OH, + PO2, + RO2, + XO2 + End Not-Transported + + END Species + + + Solution classes + Explicit + NHDEP + NDEP + End Explicit + + Implicit + bc_a1 + bc_a4 + BIGALK + BR + BRCL + BRO + BRONO2 + BRY + C2H4 + C2H5OH + C2H5OOH + C2H6 + C3H6 + C3H7OOH + C3H8 + CCL4 + CF2CLBR + CF3BR + CFC11 + CFC113 + CFC114 + CFC115 + CFC12 + CH2BR2 + CH2O + CH3BR + CH3CCL3 + CH3CHO + CH3CL + CH3COCH3 + CH3COCHO + CH3COOH + CH3COOOH + CH3OH + CH3OOH + CH4 + CHBR3 + CL + CL2 + CL2O2 + CLO + CLONO2 + CLY + CO + CO2 + DMS + dst_a1 + dst_a2 + dst_a3 + E90 + EOOH + GLYALD + GLYOXAL + H + H2 + H2402 + H2O2 + H2SO4 + HBR + HCFC141B + HCFC142B + HCFC22 + HCL + HF + HNO3 + HO2NO2 + HOBR + HOCL + HYAC + HYDRALD + ISOP + ISOPNO3 + ISOPOOH + MACR + MACROOH + MPAN + MVK + N + N2O + N2O5 + ncl_a1 + ncl_a2 + ncl_a3 + NH3 + NH4 + NH_5 + NH_50 + NO + NO2 + NO3 + NOA + num_a1 + num_a2 + num_a3 + num_a4 + num_a5 + O + O3 + O3S + OCLO + OCS + ONITR + PAN + pom_a1 + pom_a4 + POOH + ROOH + S + SF6 + SO + SO2 + SO3 + so4_a1 + so4_a2 + so4_a3 + so4_a5 + soa_a1 + soa_a2 + SOAE + SOAG + ST80_25 + TERP + XOOH + C2H5O2 + C3H7O2 + CH3CO3 + CH3O2 + EO + EO2 + HO2 + ISOPO2 + MACRO2 + MCO3 + O1D + OH + PO2 + RO2 + XO2 + H2O + End Implicit + + End Solution classes + + + CHEMISTRY + Photolysis +********************************* +*** odd-oxygen +********************************* +[jh2o_b] H2O + hv -> H2 + O1D +[jh2o_a] H2O + hv -> OH + H +[jh2o_c] H2O + hv -> 2*H + O +[jh2o2] H2O2 + hv -> 2*OH +[jo2_a=userdefined,] O2 + hv -> O + O1D +[jo2_b=userdefined,] O2 + hv -> 2*O +[jo3_a] O3 + hv -> O1D + O2 +[jo3_b] O3 + hv -> O + O2 +********************************* +*** odd-nitrogen +********************************* +[jhno3] HNO3 + hv -> NO2 + OH +[jho2no2_a] HO2NO2 + hv -> OH + NO3 +[jho2no2_b] HO2NO2 + hv -> NO2 + HO2 +[jn2o] N2O + hv -> O1D + N2 +[jn2o5_a] N2O5 + hv -> NO2 + NO3 +[jn2o5_b] N2O5 + hv -> NO + O + NO3 +[jno=userdefined,] NO + hv -> N + O +[jno2] NO2 + hv -> NO + O +[jno3_b] NO3 + hv -> NO + O2 +[jno3_a] NO3 + hv -> NO2 + O +********************************* +*** organics +********************************* +[jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH +[jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 +[jch2o_a] CH2O + hv -> CO + 2*H +[jch2o_b] CH2O + hv -> CO + H2 +[jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2 +[jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2 +[jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2 +[jch3co3h->,0.28*jh2o2] CH3COOOH + hv -> CH3O2 + OH + CO2 +[jch3ooh] CH3OOH + hv -> CH2O + H + OH +[jch4_b] CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H + 0.44*CO2 + 0.38*CO + 0.05*H2O +[jch4_a] CH4 + hv -> H + CH3O2 +[jco2] CO2 + hv -> CO + O +[jeooh->,jch3ooh] EOOH + hv -> EO + OH +[jglyald] GLYALD + hv -> 2*HO2 + CO + CH2O +[jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2 +[jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O +[jisopooh->,jch3ooh] ISOPOOH + hv -> 0.402*MVK + 0.288*MACR + 0.69*CH2O + HO2 +[jmacr_a] MACR + hv -> 1.34*HO2 + 0.66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 +[jmacr_b] MACR + hv -> 0.66*HO2 + 1.34*CO +[jmpan->,jpan] MPAN + hv -> MCO3 + NO2 +[jmvk] MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 +[jnoa->,jch2o_a] NOA + hv -> NO2 + CH2O + CH3CO3 +[jonitr->,jch3cho] ONITR + hv -> HO2 + CO + NO2 + CH2O +[jpan] PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 +[jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH +[jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH +[jxooh->,jch3ooh] XOOH + hv -> OH +********************************* +*** halogens +********************************* +[jbrcl] BRCL + hv -> BR + CL +[jbro] BRO + hv -> BR + O +[jbrono2_b] BRONO2 + hv -> BRO + NO2 +[jbrono2_a] BRONO2 + hv -> BR + NO3 +[jccl4] CCL4 + hv -> 4*CL +[jcf2clbr] CF2CLBR + hv -> BR + CL + COF2 +[jcf3br] CF3BR + hv -> BR + F + COF2 +[jcfcl3] CFC11 + hv -> 3*CL +[jcfc113] CFC113 + hv -> 3*CL +[jcfc114] CFC114 + hv -> 2*CL + 2*COF2 +[jcfc115] CFC115 + hv -> CL + F + 2*COF2 +[jcf2cl2] CFC12 + hv -> 2*CL + COF2 +[jch2br2] CH2BR2 + hv -> 2*BR +[jch3br] CH3BR + hv -> BR + CH3O2 +[jch3ccl3] CH3CCL3 + hv -> 3*CL +[jch3cl] CH3CL + hv -> CL + CH3O2 +[jchbr3] CHBR3 + hv -> 3*BR +[jcl2] CL2 + hv -> 2*CL +[jcl2o2] CL2O2 + hv -> 2*CL +[jclo] CLO + hv -> CL + O +[jclono2_b] CLONO2 + hv -> CLO + NO2 +[jclono2_a] CLONO2 + hv -> CL + NO3 +[jh2402] H2402 + hv -> 2*BR + 2*COF2 +[jhbr] HBR + hv -> BR + H +[jhcfc141b] HCFC141B + hv -> CL + COFCL +[jhcfc142b] HCFC142B + hv -> CL + COF2 +[jhcfc22] HCFC22 + hv -> CL + COF2 +[jhcl] HCL + hv -> H + CL +[jhf] HF + hv -> H + F +[jhobr] HOBR + hv -> BR + OH +[jhocl] HOCL + hv -> OH + CL +[joclo] OCLO + hv -> O + CLO +[jsf6] SF6 + hv -> sink +********************************* +*** sulfur +********************************* +[jh2so4] H2SO4 + hv -> SO3 + H2O +[jocs] OCS + hv -> S + CO +[jso] SO + hv -> S + O +[jso2] SO2 + hv -> SO + O +[jso3] SO3 + hv -> SO2 + O +********************************* +*** soa +********************************* +[jsoa_a1->,.0004*jno2] soa_a1 + hv -> +[jsoa_a2->,.0004*jno2] soa_a2 + hv -> + End Photolysis + + Reactions +********************************* +*** odd-oxygen +********************************* +[O1D_H2] O1D + H2 -> H + OH ; 1.2e-10 +[O1D_H2O] O1D + H2O -> 2*OH ; 1.63e-10, 60 +[O1D_N2,cph=189.81] O1D + N2 -> O + N2 ; 2.15e-11, 110 +[O1D_O2ab] O1D + O2 -> O + O2 ; 3.3e-11, 55 +[O1D_O3] O1D + O3 -> O2 + O2 ; 1.2e-10 +[O1D_O3a] O1D + O3 -> O2 + 2*O ; 1.2e-10 +[O_O3,cph=392.19] O + O3 -> 2*O2 ; 8e-12, -2060 +[usr_O_O,cph=493.58] O + O + M -> O2 + M +[usr_O_O2,cph=101.39] O + O2 + M -> O3 + M +********************************* +*** odd-hydrogen +********************************* +[H2_O] H2 + O -> OH + H ; 1.6e-11, -4570 +[H2O2_O] H2O2 + O -> OH + HO2 ; 1.4e-12, -2000 +[H_HO2,cph=232.59] H + HO2 -> H2 + O2 ; 6.9e-12 +[H_HO2a] H + HO2 -> 2*OH ; 7.2e-11 +[H_HO2b] H + HO2 -> H2O + O ; 1.6e-12 +[H_O2,cph=203.4] H + O2 + M -> HO2 + M ; 5.3e-32, 1.8, 9.5e-11, -0.4, 0.6 +[HO2_O,cph=226.58] HO2 + O -> OH + O2 ; 3e-11, 200 +[HO2_O3,cph=120.1] HO2 + O3 -> OH + 2*O2 ; 1e-14, -490 +[H_O3,cph=194.71] H + O3 -> OH + O2 ; 1.4e-10, -470 +[OH_H2] OH + H2 -> H2O + H ; 2.8e-12, -1800 +[OH_H2O2] OH + H2O2 -> H2O + HO2 ; 1.8e-12 +[OH_HO2,cph=293.62] OH + HO2 -> H2O + O2 ; 4.8e-11, 250 +[OH_O,cph=67.67] OH + O -> H + O2 ; 1.8e-11, 180 +[OH_O3,cph=165.3] OH + O3 -> HO2 + O2 ; 1.7e-12, -940 +[OH_OH] OH + OH -> H2O + O ; 1.8e-12 +[OH_OH_M] OH + OH + M -> H2O2 + M ; 6.9e-31, 1, 2.6e-11, 0, 0.6 +[usr_HO2_HO2,cph=165.51] HO2 + HO2 -> H2O2 + O2 +********************************* +*** odd-nitrogen +********************************* +[HO2NO2_OH] HO2NO2 + OH -> H2O + NO2 + O2 ; 4.5e-13, 610 +[N_NO,cph=313.75] N + NO -> N2 + O ; 2.1e-11, 100 +[N_NO2a] N + NO2 -> N2O + O ; 2.9e-12, 220 +[N_NO2b] N + NO2 -> 2*NO ; 1.45e-12, 220 +[N_NO2c] N + NO2 -> N2 + O2 ; 1.45e-12, 220 +[N_O2,cph=133.75] N + O2 -> NO + O ; 3.3e-12, -3150 +[NO2_O,cph=193.02] NO2 + O -> NO + O2 ; 5.1e-12, 210 +[NO2_O3] NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450 +[NO2_O_M] NO2 + O + M -> NO3 + M ; 2.5e-31, 1.8, 2.2e-11, 0.7, 0.6 +[NO3_HO2] NO3 + HO2 -> OH + NO2 + O2 ; 3.5e-12 +[NO3_NO] NO3 + NO -> 2*NO2 ; 1.7e-11, 125 +[NO3_O] NO3 + O -> NO2 + O2 ; 1.3e-11 +[NO3_OH] NO3 + OH -> HO2 + NO2 ; 2.2e-11 +[N_OH] N + OH -> NO + H ; 5e-11 +[NO_HO2,cph=34.47] NO + HO2 -> NO2 + OH ; 3.44e-12, 260 +[NO_O3,cph=199.17] NO + O3 -> NO2 + O2 ; 3e-12, -1500 +[NO_O_M] NO + O + M -> NO2 + M ; 9e-32, 1.5, 3e-11, 0, 0.6 +[O1D_N2Oa] O1D + N2O -> 2*NO ; 7.26e-11, 20 +[O1D_N2Ob] O1D + N2O -> N2 + O2 ; 4.64e-11, 20 +[tag_NO2_HO2] NO2 + HO2 + M -> HO2NO2 + M ; 1.9e-31, 3.4, 4e-12, 0.3, 0.6 +[tag_NO2_NO3] NO2 + NO3 + M -> N2O5 + M ; 2.4e-30, 3, 1.6e-12, -0.1, 0.6 +[tag_NO2_OH] NO2 + OH + M -> HNO3 + M ; 1.8e-30, 3, 2.8e-11, 0, 0.6 +[usr_HNO3_OH] HNO3 + OH -> NO3 + H2O +[usr_HO2NO2_M] HO2NO2 + M -> HO2 + NO2 + M +[usr_N2O5_M] N2O5 + M -> NO2 + NO3 + M +********************************* +*** odd-chlorine +********************************* +[CL_CH2O] CL + CH2O -> HCL + HO2 + CO ; 8.1e-11, -30 +[CL_CH4] CL + CH4 -> CH3O2 + HCL ; 7.1e-12, -1270 +[CL_H2] CL + H2 -> HCL + H ; 3.05e-11, -2270 +[CL_H2O2] CL + H2O2 -> HCL + HO2 ; 1.1e-11, -980 +[CL_HO2a] CL + HO2 -> HCL + O2 ; 1.4e-11, 270 +[CL_HO2b] CL + HO2 -> OH + CLO ; 3.6e-11, -375 +[CL_O3] CL + O3 -> CLO + O2 ; 2.3e-11, -200 +[CLO_CH3O2] CLO + CH3O2 -> CL + HO2 + CH2O ; 3.3e-12, -115 +[CLO_CLOa] CLO + CLO -> 2*CL + O2 ; 3e-11, -2450 +[CLO_CLOb] CLO + CLO -> CL2 + O2 ; 1e-12, -1590 +[CLO_CLOc] CLO + CLO -> CL + OCLO ; 3.5e-13, -1370 +[CLO_HO2] CLO + HO2 -> O2 + HOCL ; 2.6e-12, 290 +[CLO_NO] CLO + NO -> NO2 + CL ; 6.4e-12, 290 +[CLONO2_CL] CLONO2 + CL -> CL2 + NO3 ; 6.5e-12, 135 +[CLO_NO2_M] CLO + NO2 + M -> CLONO2 + M ; 1.8e-31, 3.4, 1.5e-11, 1.9, 0.6 +[CLONO2_O] CLONO2 + O -> CLO + NO3 ; 3.6e-12, -840 +[CLONO2_OH] CLONO2 + OH -> HOCL + NO3 ; 1.2e-12, -330 +[CLO_O] CLO + O -> CL + O2 ; 2.8e-11, 85 +[CLO_OHa] CLO + OH -> CL + HO2 ; 7.4e-12, 270 +[CLO_OHb] CLO + OH -> HCL + O2 ; 6e-13, 230 +[HCL_O] HCL + O -> CL + OH ; 1e-11, -3300 +[HCL_OH] HCL + OH -> H2O + CL ; 1.8e-12, -250 +[HOCL_CL] HOCL + CL -> HCL + CLO ; 3.4e-12, -130 +[HOCL_O] HOCL + O -> CLO + OH ; 1.7e-13 +[HOCL_OH] HOCL + OH -> H2O + CLO ; 3e-12, -500 +[O1D_CCL4] O1D + CCL4 -> 4*CL ; 2.607e-10 +[O1D_CF2CLBR] O1D + CF2CLBR -> CL + BR + COF2 ; 9.75e-11 +[O1D_CFC11] O1D + CFC11 -> 3*CL ; 2.07e-10 +[O1D_CFC113] O1D + CFC113 -> 3*CL ; 2.088e-10 +[O1D_CFC114] O1D + CFC114 -> 2*CL + 2*COF2 ; 1.17e-10 +[O1D_CFC115] O1D + CFC115 -> CL + F + 2*COF2 ; 4.644e-11 +[O1D_CFC12] O1D + CFC12 -> 2*CL + COF2 ; 1.204e-10 +[O1D_HCLa] O1D + HCL -> CL + OH ; 9.9e-11 +[O1D_HCLb] O1D + HCL -> CLO + H ; 3.3e-12 +[tag_CLO_CLO_M] CLO + CLO + M -> CL2O2 + M ; 1.9e-32, 3.6, 3.7e-12, 1.6, 0.6 +[usr_CL2O2_M] CL2O2 + M -> CLO + CLO + M +********************************* +*** odd-bromine +********************************* +[BR_CH2O] BR + CH2O -> HBR + HO2 + CO ; 1.7e-11, -800 +[BR_HO2] BR + HO2 -> HBR + O2 ; 4.8e-12, -310 +[BR_O3] BR + O3 -> BRO + O2 ; 1.6e-11, -780 +[BRO_BRO] BRO + BRO -> 2*BR + O2 ; 1.5e-12, 230 +[BRO_CLOa] BRO + CLO -> BR + OCLO ; 9.5e-13, 550 +[BRO_CLOb] BRO + CLO -> BR + CL + O2 ; 2.3e-12, 260 +[BRO_CLOc] BRO + CLO -> BRCL + O2 ; 4.1e-13, 290 +[BRO_HO2] BRO + HO2 -> HOBR + O2 ; 4.5e-12, 460 +[BRO_NO] BRO + NO -> BR + NO2 ; 8.8e-12, 260 +[BRO_NO2_M] BRO + NO2 + M -> BRONO2 + M ; 5.2e-31, 3.2, 6.9e-12, 2.9, 0.6 +[BRONO2_O] BRONO2 + O -> BRO + NO3 ; 1.9e-11, 215 +[BRO_O] BRO + O -> BR + O2 ; 1.9e-11, 230 +[BRO_OH] BRO + OH -> BR + HO2 ; 1.7e-11, 250 +[HBR_O] HBR + O -> BR + OH ; 5.8e-12, -1500 +[HBR_OH] HBR + OH -> BR + H2O ; 5.5e-12, 200 +[HOBR_O] HOBR + O -> BRO + OH ; 1.2e-10, -430 +[O1D_CF3BR] O1D + CF3BR -> BR + F + COF2 ; 4.5e-11 +[O1D_CHBR3] O1D + CHBR3 -> 3*BR ; 4.62e-10 +[O1D_H2402] O1D + H2402 -> 2*BR + 2*COF2 ; 1.2e-10 +[O1D_HBRa] O1D + HBR -> BR + OH ; 9e-11 +[O1D_HBRb] O1D + HBR -> BRO + H ; 3e-11 +********************************* +*** organic-halogens +********************************* +[CH2BR2_CL] CH2BR2 + CL -> 2*BR + HCL ; 6.3e-12, -800 +[CH2BR2_OH] CH2BR2 + OH -> 2*BR + H2O ; 2e-12, -840 +[CH3BR_CL] CH3BR + CL -> HCL + HO2 + BR ; 1.46e-11, -1040 +[CH3BR_OH] CH3BR + OH -> BR + H2O + HO2 ; 1.42e-12, -1150 +[CH3CCL3_OH] CH3CCL3 + OH -> H2O + 3*CL ; 1.64e-12, -1520 +[CH3CL_CL] CH3CL + CL -> HO2 + CO + 2*HCL ; 2.03e-11, -1100 +[CH3CL_OH] CH3CL + OH -> CL + H2O + HO2 ; 1.96e-12, -1200 +[CHBR3_CL] CHBR3 + CL -> 3*BR + HCL ; 4.85e-12, -850 +[CHBR3_OH] CHBR3 + OH -> 3*BR ; 9e-13, -360 +[HCFC141B_OH] HCFC141B + OH -> CL + CL ; 1.25e-12, -1600 +[HCFC142B_OH] HCFC142B + OH -> CL + COF2 ; 1.3e-12, -1770 +[HCFC22_OH] HCFC22 + OH -> H2O + CL + COF2 ; 9.2e-13, -1560 +[O1D_CH2BR2] O1D + CH2BR2 -> 2*BR ; 2.57e-10 +[O1D_CH3BR] O1D + CH3BR -> BR ; 1.8e-10 +[O1D_HCFC141B] O1D + HCFC141B -> CL + CL ; 1.794e-10 +[O1D_HCFC142B] O1D + HCFC142B -> CL + COF2 ; 1.3e-10 +[O1D_HCFC22] O1D + HCFC22 -> CL + COF2 ; 7.65e-11 +********************************* +*** C1 +********************************* +[CH2O_NO3] CH2O + NO3 -> CO + HO2 + HNO3 ; 6e-13, -2058 +[CH2O_O] CH2O + O -> HO2 + OH + CO ; 3.4e-11, -1600 +[CH2O_OH] CH2O + OH -> CO + H2O + H ; 5.5e-12, 125 +[CH3O2_CH3O2a] CH3O2 + CH3O2 -> 2*CH2O + 2*HO2 ; 5e-13, -424 +[CH3O2_CH3O2b] CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14, 706 +[CH3O2_HO2] CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750 +[CH3O2_NO] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300 +[CH3OH_OH] CH3OH + OH -> HO2 + CH2O ; 2.9e-12, -345 +[CH3OOH_OH] CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O ; 3.8e-12, 200 +[CH4_OH] CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775 +[O1D_CH4a] O1D + CH4 -> CH3O2 + OH ; 1.31e-10 +[O1D_CH4b] O1D + CH4 -> CH2O + H + HO2 ; 3.5e-11 +[O1D_CH4c] O1D + CH4 -> CH2O + H2 ; 9e-12 +[usr_CO_OH] CO + OH -> CO2 + HO2 +********************************* +*** C2 +********************************* +[C2H4_CL_M] C2H4 + CL + M -> CL + M ; 1.6e-29, 3.3, 3.1e-10, 1, 0.6 +[C2H4_O3] C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*HCOOH + CH2O ; 1.2e-14, -2630 +[C2H5O2_C2H5O2] C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH ; 6.8e-14 +[C2H5O2_CH3O2] C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH + 0.2*C2H5OH ; 2e-13 +[C2H5O2_HO2] C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700 +[C2H5O2_NO] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365 +[C2H5OH_OH] C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12, -230 +[C2H5OOH_OH] C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH ; 3.8e-12, 200 +[C2H6_CL] C2H6 + CL -> HCL + C2H5O2 ; 7.2e-11, -70 +[C2H6_OH] C2H6 + OH -> C2H5O2 + H2O ; 7.66e-12, -1020 +[CH3CHO_NO3] CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900 +[CH3CHO_OH] CH3CHO + OH -> CH3CO3 + H2O ; 4.63e-12, 350 +[CH3CO3_CH3CO3] CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.9e-12, 500 +[CH3CO3_CH3O2] CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 + 0.1*CH3COOH ; 2e-12, 500 +[CH3CO3_HO2] CH3CO3 + HO2 -> 0.4*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.45*OH + 0.45*CH3O2 ; 4.3e-13, 1040 +[CH3CO3_NO] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270 +[CH3COOH_OH] CH3COOH + OH -> CH3O2 + CO2 + H2O ; 3.15e-14, 920 +[CH3COOOH_OH] CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O ; 1e-12 +[EO2_HO2] EO2 + HO2 -> EOOH ; 7.5e-13, 700 +[EO2_NO] EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 ; 4.2e-12, 180 +[EO_M] EO -> 2*CH2O + HO2 ; 1.6e+11, -4150 +[EO_O2] EO + O2 -> GLYALD + HO2 ; 1e-14 +[GLYALD_OH] GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 ; 1e-11 +[GLYOXAL_OH] GLYOXAL + OH -> HO2 + CO + CO2 ; 1.15e-11 +[PAN_OH] PAN + OH -> CH2O + NO3 ; 4e-14 +[tag_C2H4_OH] C2H4 + OH + M -> EO2 + M ; 8.6e-29, 3.1, 9e-12, 0.85, 0.48 +[tag_CH3CO3_NO2] CH3CO3 + NO2 + M -> PAN + M ; 7.3e-29, 4.1, 9.5e-12, 1.6, 0.6 +[usr_PAN_M] PAN + M -> CH3CO3 + NO2 + M +********************************* +*** C3 +********************************* +[C3H6_NO3] C3H6 + NO3 -> NOA ; 4.6e-13, -1156 +[C3H6_O3] C3H6 + O3 -> 0.5*CH2O + 0.12*HCOOH + 0.12*CH3COOH + 0.5*CH3CHO + 0.56*CO + 0.28*CH3O2 + 0.1*CH4 + 0.2*CO2 + 0.28*HO2 + 0.36*OH ; 6.5e-15, -1900 +[C3H7O2_CH3O2] C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 ; 3.75e-13, -40 +[C3H7O2_HO2] C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700 +[C3H7O2_NO] C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO ; 4.2e-12, 180 +[C3H7OOH_OH] C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200 +[C3H8_OH] C3H8 + OH -> C3H7O2 + H2O ; 9.19e-12, -630 +[CH3COCHO_NO3] CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860 +[CH3COCHO_OH] CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13, 830 +[HYAC_OH] HYAC + OH -> CH3COCHO + HO2 ; 3e-12 +[NOA_OH] NOA + OH -> NO2 + CH3COCHO ; 6.7e-13 +[PO2_HO2] PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700 +[PO2_NO] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180 +[POOH_OH] POOH + OH -> 0.5*PO2 + 0.5*OH + 0.5*HYAC + H2O ; 3.8e-12, 200 +[RO2_CH3O2] RO2 + CH3O2 -> 0.3*CH3CO3 + 0.8*CH2O + 0.3*HO2 + 0.2*HYAC + 0.5*CH3COCHO + 0.5*CH3OH ; 7.1e-13, 500 +[RO2_HO2] RO2 + HO2 -> 0.85*ROOH + 0.15*OH + 0.15*CH2O + 0.15*CH3CO3 ; 8.6e-13, 700 +[RO2_NO] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300 +[ROOH_OH] ROOH + OH -> RO2 + H2O ; 3.8e-12, 200 +[tag_C3H6_OH] C3H6 + OH + M -> PO2 + M ; 8e-27, 3.5, 3e-11, 0, 0.5 +[usr_CH3COCH3_OH] CH3COCH3 + OH -> RO2 + H2O +********************************* +*** C4 +********************************* +[MACRO2_CH3CO3] MACRO2 + CH3CO3 -> 0.25*CH3COCHO + CH3O2 + 0.22*CO + 0.47*HO2 + 0.53*GLYALD + 0.22*HYAC + 0.25*CH2O + 0.53*CH3CO3 ; 1.4e-11 +[MACRO2_CH3O2] MACRO2 + CH3O2 -> 0.73*HO2 + 0.88*CH2O + 0.11*CO + 0.24*CH3COCHO + 0.26*GLYALD + 0.26*CH3CO3 + 0.25*CH3OH + 0.23*HYAC ; 5e-13, 400 +[MACRO2_HO2] MACRO2 + HO2 -> MACROOH ; 8e-13, 700 +[MACRO2_NO3] MACRO2 + NO3 -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.25*CH3COCHO + 0.22*CO + 0.53*GLYALD + 0.22*HYAC + 0.53*CH3CO3 ; 2.4e-12 +[MACRO2_NOa] MACRO2 + NO -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.53*GLYALD + 0.25*CH3COCHO + 0.53*CH3CO3 + 0.22*HYAC + 0.22*CO ; 2.7e-12, 360 +[MACRO2_NOb] MACRO2 + NO -> 0.8*ONITR ; 1.3e-13, 360 +[MACR_O3] MACR + O3 -> 0.12*CH2O + 0.24*OH + 0.65*CO + 0.1*CH3CO3 + 0.88*CH3COCHO + 0.33*HCOOH + 0.14*HO2 ; 1.5e-15, -2100 +[MACR_OH] MACR + OH -> 0.5*MACRO2 + 0.5*H2O + 0.5*MCO3 ; 9.6e-12, 360 +[MACROOH_OH] MACROOH + OH -> 0.5*MCO3 + 0.2*MACRO2 + 0.1*OH + 0.2*HO2 ; 2.3e-11, 200 +[MCO3_CH3CO3] MCO3 + CH3CO3 -> 2*CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530 +[MCO3_CH3O2] MCO3 + CH3O2 -> 2*CH2O + HO2 + CO2 + CH3CO3 ; 2e-12, 500 +[MCO3_HO2] MCO3 + HO2 -> 0.15*O3 + 0.15*CH3COOH + 0.4*CH3COOOH + 0.45*OH + 0.45*CO2 + 0.45*CH2O + 0.45*CH3CO3 ; 4.3e-13, 1040 +[MCO3_MCO3] MCO3 + MCO3 -> 2*CO2 + 2*CH2O + 2*CH3CO3 ; 2.3e-12, 530 +[MCO3_NO] MCO3 + NO -> NO2 + CH2O + CH3CO3 ; 5.3e-12, 360 +[MCO3_NO3] MCO3 + NO3 -> NO2 + CH2O + CH3CO3 ; 5e-12 +[MPAN_OH_M] MPAN + OH + M -> 0.5*HYAC + 0.5*NO3 + 0.5*CH2O + 0.5*HO2 + 0.5*CO2 + M + 0.5*NDEP ; 8e-27, 3.5, 3e-11, 0, 0.5 +[MVK_O3] MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 + 0.5*CH3COCHO + 0.28*HO2 + 0.36*OH + 0.12*HCOOH ; 8.5e-16, -1520 +[MVK_OH] MVK + OH -> MACRO2 ; 4.13e-12, 452 +[tag_MCO3_NO2] MCO3 + NO2 + M -> MPAN + M ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[usr_MPAN_M] MPAN + M -> MCO3 + NO2 + M +********************************* +*** C5 +********************************* +[BIGALK_OH] BIGALK + OH -> 1.67*C3H7O2 ; 3.5e-12 +[HYDRALD_OH] HYDRALD + OH -> XO2 ; 1.86e-11, 175 +[ISOP_NO3] ISOP + NO3 -> ISOPNO3 ; 3.03e-12, -446 +[ISOPNO3_HO2] ISOPNO3 + HO2 -> 0.206*NO2 + 0.206*CH2O + 0.206*OH + 0.167*MACR + 0.039*MVK + 0.794*ONITR ; 8e-13, 700 +[ISOPNO3_NO] ISOPNO3 + NO -> 1.206*NO2 + 0.794*HO2 + 0.072*CH2O + 0.167*MACR + 0.039*MVK + 0.794*ONITR ; 2.7e-12, 360 +[ISOPNO3_NO3] ISOPNO3 + NO3 -> 1.206*NO2 + 0.072*CH2O + 0.167*MACR + 0.039*MVK + 0.794*ONITR + 0.794*HO2 ; 2.4e-12 +[ISOPO2_CH3CO3] ISOPO2 + CH3CO3 -> CH3O2 + HO2 + 0.6*CH2O + 0.25*MACR + 0.35*MVK + 0.4*HYDRALD ; 1.4e-11 +[ISOPO2_CH3O2] ISOPO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.2*CH2O + 0.19*MACR + 0.26*MVK + 0.3*HYDRALD ; 5e-13, 400 +[ISOPO2_HO2] ISOPO2 + HO2 -> ISOPOOH ; 8e-13, 700 +[ISOPO2_NO] ISOPO2 + NO -> 0.08*ONITR + 0.92*NO2 + 0.23*MACR + 0.32*MVK + 0.33*HYDRALD + 0.02*GLYOXAL + 0.02*GLYALD + 0.02*CH3COCHO + 0.02*HYAC + 0.55*CH2O + 0.92*HO2 ; 4.4e-12, 180 +[ISOPO2_NO3] ISOPO2 + NO3 -> HO2 + NO2 + 0.6*CH2O + 0.25*MACR + 0.35*MVK + 0.4*HYDRALD ; 2.4e-12 +[ISOP_O3] ISOP + O3 -> 0.3*MACR + 0.2*MVK + 0.11*HCOOH + 0.62*CO + 0.32*OH + 0.37*HO2 + 0.91*CH2O + 0.08*CH3CO3 + 0.13*C3H6 + 0.05*CH3O2 ; 1.05e-14, -2000 +[ISOP_OH] ISOP + OH -> ISOPO2 ; 2.54e-11, 410 +[ISOPOOH_OH] ISOPOOH + OH -> 0.8*XO2 + 0.2*ISOPO2 ; 1.52e-11, 200 +[ONITR_NO3] ONITR + NO3 -> HO2 + NO2 + HYDRALD ; 1.4e-12, -1860 +[ONITR_OH] ONITR + OH -> HYDRALD + 0.4*NO2 + HO2 ; 4.5e-11 +[XO2_CH3CO3] XO2 + CH3CO3 -> 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + CH3O2 + HO2 + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + CO2 ; 1.3e-12, 640 +[XO2_CH3O2] XO2 + CH3O2 -> 0.3*CH3OH + 0.8*HO2 + 0.8*CH2O + 0.2*CO + 0.1*GLYOXAL + 0.1*CH3COCHO + 0.1*HYAC + 0.1*GLYALD ; 5e-13, 400 +[XO2_HO2] XO2 + HO2 -> XOOH ; 8e-13, 700 +[XO2_NO] XO2 + NO -> NO2 + HO2 + 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD ; 2.7e-12, 360 +[XO2_NO3] XO2 + NO3 -> NO2 + HO2 + 0.5*CO + 0.25*HYAC + 0.25*GLYOXAL + 0.25*CH3COCHO + 0.25*GLYALD ; 2.4e-12 +[XOOH_OH] XOOH + OH -> 0.5*XO2 + 0.5*OH ; 1.52e-12, 200 +********************************* +*** C10 +********************************* +[TERP_NO3] TERP + NO3 -> 1.7*ISOPO2 + NO2 ; 1.2e-12, 490 +[TERP_O3] TERP + O3 -> 1.122*MACR + 0.442*MVK + 0.765*O + 1.156*OH ; 6.3e-16, -580 +[TERP_OH] TERP + OH -> 1.64*ISOPO2 + 0.1*CH3COCH3 ; 1.2e-11, 440 +********************************* +*** Sulfur +********************************* +[DMS_NO3] DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520 +[DMS_OHa] DMS + OH -> SO2 ; 1.1e-11, -280 +[OCS_O] OCS + O -> SO + CO ; 2.1e-11, -2200 +[OCS_OH] OCS + OH -> SO2 + CO + H ; 7.2e-14, -1070 +[S_O2] S + O2 -> SO + O ; 2.3e-12 +[SO2_OH_M] SO2 + OH + M -> SO3 + HO2 ; 2.9e-31, 4.1, 1.7e-12, -0.2, 0.6 +[S_O3] S + O3 -> SO + O2 ; 1.2e-11 +[SO_BRO] SO + BRO -> SO2 + BR ; 5.7e-11 +[SO_CLO] SO + CLO -> SO2 + CL ; 2.8e-11 +[S_OH] S + OH -> SO + H ; 6.6e-11 +[SO_NO2] SO + NO2 -> SO2 + NO ; 1.4e-11 +[SO_O2] SO + O2 -> SO2 + O ; 1.6e-13, -2280 +[SO_O3] SO + O3 -> SO2 + O2 ; 3.4e-12, -1100 +[SO_OCLO] SO + OCLO -> SO2 + CLO ; 1.9e-12 +[SO_OH] SO + OH -> SO2 + H ; 2.6e-11, 330 +[usr_DMS_OH] DMS + OH -> 0.5*SO2 + 0.5*HO2 +[usr_SO3_H2O] SO3 + H2O -> H2SO4 +********************************* +*** Tropospheric Aerosol +********************************* +[NH3_OH] NH3 + OH -> H2O + 1*NHDEP ; 1.7e-12, -710 +[usr_HO2_aer] HO2 -> H2O +[usr_N2O5_aer] N2O5 -> 2*HNO3 +[usr_NH4_strat_tau] NH4 -> 1*NHDEP ; 6.34e-08 +[usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 +[usr_NO3_aer] NO3 -> HNO3 +[usr_ONITR_aer] ONITR -> HNO3 +********************************* +*** SOA +********************************* +[SOAE_tau] SOAE -> SOAG ; 1.157e-05 +********************************* +*** Stratospheric Aerosol +********************************* +[het1] N2O5 -> 2*HNO3 +[het10] HOCL + HCL -> CL2 + H2O +[het11] BRONO2 -> HOBR + HNO3 +[het12] N2O5 -> 2*HNO3 +[het13] CLONO2 -> HOCL + HNO3 +[het14] BRONO2 -> HOBR + HNO3 +[het15] CLONO2 + HCL -> CL2 + HNO3 +[het16] HOCL + HCL -> CL2 + H2O +[het17] HOBR + HCL -> BRCL + H2O +[het2] CLONO2 -> HOCL + HNO3 +[het3] BRONO2 -> HOBR + HNO3 +[het4] CLONO2 + HCL -> CL2 + HNO3 +[het5] HOCL + HCL -> CL2 + H2O +[het6] HOBR + HCL -> BRCL + H2O +[het7] N2O5 -> 2*HNO3 +[het8] CLONO2 -> HOCL + HNO3 +[het9] CLONO2 + HCL -> CL2 + HNO3 +********************************* +*** Tracers +********************************* +[E90_tau] E90 -> sink ; 1.29e-07 +[NH_50_tau] NH_50 -> ; 2.31e-07 +[NH_5_tau] NH_5 -> ; 2.31e-06 +[ST80_25_tau] ST80_25 -> ; 4.63e-07 + End Reactions + + Ext Forcing + NO2 <- dataset + so4_a2 <- dataset + SO2 <- dataset + so4_a1 <- dataset + num_a2 <- dataset + num_a1 <- dataset + bc_a4 <- dataset + num_a4 <- dataset + NO + End Ext Forcing + + End Chemistry + + SIMULATION PARAMETERS + + Version Options + machine = nec + model = cam + model_architecture = VECTOR + vector_length = 32 + architecture = hybrid + namemod = on + End Version Options + + + End Simulation Parameters diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/chem_mods.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/chem_mods.F90 new file mode 100644 index 0000000000..3c9024e6f9 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/chem_mods.F90 @@ -0,0 +1,51 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 85, & ! number of photolysis reactions + rxntot = 363, & ! number of total reactions + gascnt = 278, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 141, & ! number of "gas phase" species + nfs = 3, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 1307, & ! number of non-zero matrix entries + extcnt = 9, & ! number of species with external forcing + clscnt1 = 2, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 139, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 0, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 363, & + enthalpy_cnt = 18, & + nslvd = 15 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + integer, parameter :: veclen = 32 + end module chem_mods diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/m_rxt_id.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/m_rxt_id.F90 new file mode 100644 index 0000000000..b11d3b8ba0 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/m_rxt_id.F90 @@ -0,0 +1,366 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jh2o_b = 1 + integer, parameter :: rid_jh2o_a = 2 + integer, parameter :: rid_jh2o_c = 3 + integer, parameter :: rid_jh2o2 = 4 + integer, parameter :: rid_jo2_a = 5 + integer, parameter :: rid_jo2_b = 6 + integer, parameter :: rid_jo3_a = 7 + integer, parameter :: rid_jo3_b = 8 + integer, parameter :: rid_jhno3 = 9 + integer, parameter :: rid_jho2no2_a = 10 + integer, parameter :: rid_jho2no2_b = 11 + integer, parameter :: rid_jn2o = 12 + integer, parameter :: rid_jn2o5_a = 13 + integer, parameter :: rid_jn2o5_b = 14 + integer, parameter :: rid_jno = 15 + integer, parameter :: rid_jno2 = 16 + integer, parameter :: rid_jno3_b = 17 + integer, parameter :: rid_jno3_a = 18 + integer, parameter :: rid_jc2h5ooh = 19 + integer, parameter :: rid_jc3h7ooh = 20 + integer, parameter :: rid_jch2o_a = 21 + integer, parameter :: rid_jch2o_b = 22 + integer, parameter :: rid_jch3cho = 23 + integer, parameter :: rid_jacet = 24 + integer, parameter :: rid_jmgly = 25 + integer, parameter :: rid_jch3co3h = 26 + integer, parameter :: rid_jch3ooh = 27 + integer, parameter :: rid_jch4_b = 28 + integer, parameter :: rid_jch4_a = 29 + integer, parameter :: rid_jco2 = 30 + integer, parameter :: rid_jeooh = 31 + integer, parameter :: rid_jglyald = 32 + integer, parameter :: rid_jglyoxal = 33 + integer, parameter :: rid_jhyac = 34 + integer, parameter :: rid_jisopooh = 35 + integer, parameter :: rid_jmacr_a = 36 + integer, parameter :: rid_jmacr_b = 37 + integer, parameter :: rid_jmpan = 38 + integer, parameter :: rid_jmvk = 39 + integer, parameter :: rid_jnoa = 40 + integer, parameter :: rid_jonitr = 41 + integer, parameter :: rid_jpan = 42 + integer, parameter :: rid_jpooh = 43 + integer, parameter :: rid_jrooh = 44 + integer, parameter :: rid_jxooh = 45 + integer, parameter :: rid_jbrcl = 46 + integer, parameter :: rid_jbro = 47 + integer, parameter :: rid_jbrono2_b = 48 + integer, parameter :: rid_jbrono2_a = 49 + integer, parameter :: rid_jccl4 = 50 + integer, parameter :: rid_jcf2clbr = 51 + integer, parameter :: rid_jcf3br = 52 + integer, parameter :: rid_jcfcl3 = 53 + integer, parameter :: rid_jcfc113 = 54 + integer, parameter :: rid_jcfc114 = 55 + integer, parameter :: rid_jcfc115 = 56 + integer, parameter :: rid_jcf2cl2 = 57 + integer, parameter :: rid_jch2br2 = 58 + integer, parameter :: rid_jch3br = 59 + integer, parameter :: rid_jch3ccl3 = 60 + integer, parameter :: rid_jch3cl = 61 + integer, parameter :: rid_jchbr3 = 62 + integer, parameter :: rid_jcl2 = 63 + integer, parameter :: rid_jcl2o2 = 64 + integer, parameter :: rid_jclo = 65 + integer, parameter :: rid_jclono2_b = 66 + integer, parameter :: rid_jclono2_a = 67 + integer, parameter :: rid_jh2402 = 68 + integer, parameter :: rid_jhbr = 69 + integer, parameter :: rid_jhcfc141b = 70 + integer, parameter :: rid_jhcfc142b = 71 + integer, parameter :: rid_jhcfc22 = 72 + integer, parameter :: rid_jhcl = 73 + integer, parameter :: rid_jhf = 74 + integer, parameter :: rid_jhobr = 75 + integer, parameter :: rid_jhocl = 76 + integer, parameter :: rid_joclo = 77 + integer, parameter :: rid_jsf6 = 78 + integer, parameter :: rid_jh2so4 = 79 + integer, parameter :: rid_jocs = 80 + integer, parameter :: rid_jso = 81 + integer, parameter :: rid_jso2 = 82 + integer, parameter :: rid_jso3 = 83 + integer, parameter :: rid_jsoa_a1 = 84 + integer, parameter :: rid_jsoa_a2 = 85 + integer, parameter :: rid_O1D_H2 = 86 + integer, parameter :: rid_O1D_H2O = 87 + integer, parameter :: rid_O1D_N2 = 88 + integer, parameter :: rid_O1D_O2ab = 89 + integer, parameter :: rid_O1D_O3 = 90 + integer, parameter :: rid_O1D_O3a = 91 + integer, parameter :: rid_O_O3 = 92 + integer, parameter :: rid_usr_O_O = 93 + integer, parameter :: rid_usr_O_O2 = 94 + integer, parameter :: rid_H2_O = 95 + integer, parameter :: rid_H2O2_O = 96 + integer, parameter :: rid_H_HO2 = 97 + integer, parameter :: rid_H_HO2a = 98 + integer, parameter :: rid_H_HO2b = 99 + integer, parameter :: rid_H_O2 = 100 + integer, parameter :: rid_HO2_O = 101 + integer, parameter :: rid_HO2_O3 = 102 + integer, parameter :: rid_H_O3 = 103 + integer, parameter :: rid_OH_H2 = 104 + integer, parameter :: rid_OH_H2O2 = 105 + integer, parameter :: rid_OH_HO2 = 106 + integer, parameter :: rid_OH_O = 107 + integer, parameter :: rid_OH_O3 = 108 + integer, parameter :: rid_OH_OH = 109 + integer, parameter :: rid_OH_OH_M = 110 + integer, parameter :: rid_usr_HO2_HO2 = 111 + integer, parameter :: rid_HO2NO2_OH = 112 + integer, parameter :: rid_N_NO = 113 + integer, parameter :: rid_N_NO2a = 114 + integer, parameter :: rid_N_NO2b = 115 + integer, parameter :: rid_N_NO2c = 116 + integer, parameter :: rid_N_O2 = 117 + integer, parameter :: rid_NO2_O = 118 + integer, parameter :: rid_NO2_O3 = 119 + integer, parameter :: rid_NO2_O_M = 120 + integer, parameter :: rid_NO3_HO2 = 121 + integer, parameter :: rid_NO3_NO = 122 + integer, parameter :: rid_NO3_O = 123 + integer, parameter :: rid_NO3_OH = 124 + integer, parameter :: rid_N_OH = 125 + integer, parameter :: rid_NO_HO2 = 126 + integer, parameter :: rid_NO_O3 = 127 + integer, parameter :: rid_NO_O_M = 128 + integer, parameter :: rid_O1D_N2Oa = 129 + integer, parameter :: rid_O1D_N2Ob = 130 + integer, parameter :: rid_tag_NO2_HO2 = 131 + integer, parameter :: rid_tag_NO2_NO3 = 132 + integer, parameter :: rid_tag_NO2_OH = 133 + integer, parameter :: rid_usr_HNO3_OH = 134 + integer, parameter :: rid_usr_HO2NO2_M = 135 + integer, parameter :: rid_usr_N2O5_M = 136 + integer, parameter :: rid_CL_CH2O = 137 + integer, parameter :: rid_CL_CH4 = 138 + integer, parameter :: rid_CL_H2 = 139 + integer, parameter :: rid_CL_H2O2 = 140 + integer, parameter :: rid_CL_HO2a = 141 + integer, parameter :: rid_CL_HO2b = 142 + integer, parameter :: rid_CL_O3 = 143 + integer, parameter :: rid_CLO_CH3O2 = 144 + integer, parameter :: rid_CLO_CLOa = 145 + integer, parameter :: rid_CLO_CLOb = 146 + integer, parameter :: rid_CLO_CLOc = 147 + integer, parameter :: rid_CLO_HO2 = 148 + integer, parameter :: rid_CLO_NO = 149 + integer, parameter :: rid_CLONO2_CL = 150 + integer, parameter :: rid_CLO_NO2_M = 151 + integer, parameter :: rid_CLONO2_O = 152 + integer, parameter :: rid_CLONO2_OH = 153 + integer, parameter :: rid_CLO_O = 154 + integer, parameter :: rid_CLO_OHa = 155 + integer, parameter :: rid_CLO_OHb = 156 + integer, parameter :: rid_HCL_O = 157 + integer, parameter :: rid_HCL_OH = 158 + integer, parameter :: rid_HOCL_CL = 159 + integer, parameter :: rid_HOCL_O = 160 + integer, parameter :: rid_HOCL_OH = 161 + integer, parameter :: rid_O1D_CCL4 = 162 + integer, parameter :: rid_O1D_CF2CLBR = 163 + integer, parameter :: rid_O1D_CFC11 = 164 + integer, parameter :: rid_O1D_CFC113 = 165 + integer, parameter :: rid_O1D_CFC114 = 166 + integer, parameter :: rid_O1D_CFC115 = 167 + integer, parameter :: rid_O1D_CFC12 = 168 + integer, parameter :: rid_O1D_HCLa = 169 + integer, parameter :: rid_O1D_HCLb = 170 + integer, parameter :: rid_tag_CLO_CLO_M = 171 + integer, parameter :: rid_usr_CL2O2_M = 172 + integer, parameter :: rid_BR_CH2O = 173 + integer, parameter :: rid_BR_HO2 = 174 + integer, parameter :: rid_BR_O3 = 175 + integer, parameter :: rid_BRO_BRO = 176 + integer, parameter :: rid_BRO_CLOa = 177 + integer, parameter :: rid_BRO_CLOb = 178 + integer, parameter :: rid_BRO_CLOc = 179 + integer, parameter :: rid_BRO_HO2 = 180 + integer, parameter :: rid_BRO_NO = 181 + integer, parameter :: rid_BRO_NO2_M = 182 + integer, parameter :: rid_BRONO2_O = 183 + integer, parameter :: rid_BRO_O = 184 + integer, parameter :: rid_BRO_OH = 185 + integer, parameter :: rid_HBR_O = 186 + integer, parameter :: rid_HBR_OH = 187 + integer, parameter :: rid_HOBR_O = 188 + integer, parameter :: rid_O1D_CF3BR = 189 + integer, parameter :: rid_O1D_CHBR3 = 190 + integer, parameter :: rid_O1D_H2402 = 191 + integer, parameter :: rid_O1D_HBRa = 192 + integer, parameter :: rid_O1D_HBRb = 193 + integer, parameter :: rid_CH2BR2_CL = 194 + integer, parameter :: rid_CH2BR2_OH = 195 + integer, parameter :: rid_CH3BR_CL = 196 + integer, parameter :: rid_CH3BR_OH = 197 + integer, parameter :: rid_CH3CCL3_OH = 198 + integer, parameter :: rid_CH3CL_CL = 199 + integer, parameter :: rid_CH3CL_OH = 200 + integer, parameter :: rid_CHBR3_CL = 201 + integer, parameter :: rid_CHBR3_OH = 202 + integer, parameter :: rid_HCFC141B_OH = 203 + integer, parameter :: rid_HCFC142B_OH = 204 + integer, parameter :: rid_HCFC22_OH = 205 + integer, parameter :: rid_O1D_CH2BR2 = 206 + integer, parameter :: rid_O1D_CH3BR = 207 + integer, parameter :: rid_O1D_HCFC141B = 208 + integer, parameter :: rid_O1D_HCFC142B = 209 + integer, parameter :: rid_O1D_HCFC22 = 210 + integer, parameter :: rid_CH2O_NO3 = 211 + integer, parameter :: rid_CH2O_O = 212 + integer, parameter :: rid_CH2O_OH = 213 + integer, parameter :: rid_CH3O2_CH3O2a = 214 + integer, parameter :: rid_CH3O2_CH3O2b = 215 + integer, parameter :: rid_CH3O2_HO2 = 216 + integer, parameter :: rid_CH3O2_NO = 217 + integer, parameter :: rid_CH3OH_OH = 218 + integer, parameter :: rid_CH3OOH_OH = 219 + integer, parameter :: rid_CH4_OH = 220 + integer, parameter :: rid_O1D_CH4a = 221 + integer, parameter :: rid_O1D_CH4b = 222 + integer, parameter :: rid_O1D_CH4c = 223 + integer, parameter :: rid_usr_CO_OH = 224 + integer, parameter :: rid_C2H4_CL_M = 225 + integer, parameter :: rid_C2H4_O3 = 226 + integer, parameter :: rid_C2H5O2_C2H5O2 = 227 + integer, parameter :: rid_C2H5O2_CH3O2 = 228 + integer, parameter :: rid_C2H5O2_HO2 = 229 + integer, parameter :: rid_C2H5O2_NO = 230 + integer, parameter :: rid_C2H5OH_OH = 231 + integer, parameter :: rid_C2H5OOH_OH = 232 + integer, parameter :: rid_C2H6_CL = 233 + integer, parameter :: rid_C2H6_OH = 234 + integer, parameter :: rid_CH3CHO_NO3 = 235 + integer, parameter :: rid_CH3CHO_OH = 236 + integer, parameter :: rid_CH3CO3_CH3CO3 = 237 + integer, parameter :: rid_CH3CO3_CH3O2 = 238 + integer, parameter :: rid_CH3CO3_HO2 = 239 + integer, parameter :: rid_CH3CO3_NO = 240 + integer, parameter :: rid_CH3COOH_OH = 241 + integer, parameter :: rid_CH3COOOH_OH = 242 + integer, parameter :: rid_EO2_HO2 = 243 + integer, parameter :: rid_EO2_NO = 244 + integer, parameter :: rid_EO_M = 245 + integer, parameter :: rid_EO_O2 = 246 + integer, parameter :: rid_GLYALD_OH = 247 + integer, parameter :: rid_GLYOXAL_OH = 248 + integer, parameter :: rid_PAN_OH = 249 + integer, parameter :: rid_tag_C2H4_OH = 250 + integer, parameter :: rid_tag_CH3CO3_NO2 = 251 + integer, parameter :: rid_usr_PAN_M = 252 + integer, parameter :: rid_C3H6_NO3 = 253 + integer, parameter :: rid_C3H6_O3 = 254 + integer, parameter :: rid_C3H7O2_CH3O2 = 255 + integer, parameter :: rid_C3H7O2_HO2 = 256 + integer, parameter :: rid_C3H7O2_NO = 257 + integer, parameter :: rid_C3H7OOH_OH = 258 + integer, parameter :: rid_C3H8_OH = 259 + integer, parameter :: rid_CH3COCHO_NO3 = 260 + integer, parameter :: rid_CH3COCHO_OH = 261 + integer, parameter :: rid_HYAC_OH = 262 + integer, parameter :: rid_NOA_OH = 263 + integer, parameter :: rid_PO2_HO2 = 264 + integer, parameter :: rid_PO2_NO = 265 + integer, parameter :: rid_POOH_OH = 266 + integer, parameter :: rid_RO2_CH3O2 = 267 + integer, parameter :: rid_RO2_HO2 = 268 + integer, parameter :: rid_RO2_NO = 269 + integer, parameter :: rid_ROOH_OH = 270 + integer, parameter :: rid_tag_C3H6_OH = 271 + integer, parameter :: rid_usr_CH3COCH3_OH = 272 + integer, parameter :: rid_MACRO2_CH3CO3 = 273 + integer, parameter :: rid_MACRO2_CH3O2 = 274 + integer, parameter :: rid_MACRO2_HO2 = 275 + integer, parameter :: rid_MACRO2_NO3 = 276 + integer, parameter :: rid_MACRO2_NOa = 277 + integer, parameter :: rid_MACRO2_NOb = 278 + integer, parameter :: rid_MACR_O3 = 279 + integer, parameter :: rid_MACR_OH = 280 + integer, parameter :: rid_MACROOH_OH = 281 + integer, parameter :: rid_MCO3_CH3CO3 = 282 + integer, parameter :: rid_MCO3_CH3O2 = 283 + integer, parameter :: rid_MCO3_HO2 = 284 + integer, parameter :: rid_MCO3_MCO3 = 285 + integer, parameter :: rid_MCO3_NO = 286 + integer, parameter :: rid_MCO3_NO3 = 287 + integer, parameter :: rid_MPAN_OH_M = 288 + integer, parameter :: rid_MVK_O3 = 289 + integer, parameter :: rid_MVK_OH = 290 + integer, parameter :: rid_tag_MCO3_NO2 = 291 + integer, parameter :: rid_usr_MPAN_M = 292 + integer, parameter :: rid_BIGALK_OH = 293 + integer, parameter :: rid_HYDRALD_OH = 294 + integer, parameter :: rid_ISOP_NO3 = 295 + integer, parameter :: rid_ISOPNO3_HO2 = 296 + integer, parameter :: rid_ISOPNO3_NO = 297 + integer, parameter :: rid_ISOPNO3_NO3 = 298 + integer, parameter :: rid_ISOPO2_CH3CO3 = 299 + integer, parameter :: rid_ISOPO2_CH3O2 = 300 + integer, parameter :: rid_ISOPO2_HO2 = 301 + integer, parameter :: rid_ISOPO2_NO = 302 + integer, parameter :: rid_ISOPO2_NO3 = 303 + integer, parameter :: rid_ISOP_O3 = 304 + integer, parameter :: rid_ISOP_OH = 305 + integer, parameter :: rid_ISOPOOH_OH = 306 + integer, parameter :: rid_ONITR_NO3 = 307 + integer, parameter :: rid_ONITR_OH = 308 + integer, parameter :: rid_XO2_CH3CO3 = 309 + integer, parameter :: rid_XO2_CH3O2 = 310 + integer, parameter :: rid_XO2_HO2 = 311 + integer, parameter :: rid_XO2_NO = 312 + integer, parameter :: rid_XO2_NO3 = 313 + integer, parameter :: rid_XOOH_OH = 314 + integer, parameter :: rid_TERP_NO3 = 315 + integer, parameter :: rid_TERP_O3 = 316 + integer, parameter :: rid_TERP_OH = 317 + integer, parameter :: rid_DMS_NO3 = 318 + integer, parameter :: rid_DMS_OHa = 319 + integer, parameter :: rid_OCS_O = 320 + integer, parameter :: rid_OCS_OH = 321 + integer, parameter :: rid_S_O2 = 322 + integer, parameter :: rid_SO2_OH_M = 323 + integer, parameter :: rid_S_O3 = 324 + integer, parameter :: rid_SO_BRO = 325 + integer, parameter :: rid_SO_CLO = 326 + integer, parameter :: rid_S_OH = 327 + integer, parameter :: rid_SO_NO2 = 328 + integer, parameter :: rid_SO_O2 = 329 + integer, parameter :: rid_SO_O3 = 330 + integer, parameter :: rid_SO_OCLO = 331 + integer, parameter :: rid_SO_OH = 332 + integer, parameter :: rid_usr_DMS_OH = 333 + integer, parameter :: rid_usr_SO3_H2O = 334 + integer, parameter :: rid_NH3_OH = 335 + integer, parameter :: rid_usr_HO2_aer = 336 + integer, parameter :: rid_usr_N2O5_aer = 337 + integer, parameter :: rid_usr_NH4_strat_tau = 338 + integer, parameter :: rid_usr_NO2_aer = 339 + integer, parameter :: rid_usr_NO3_aer = 340 + integer, parameter :: rid_usr_ONITR_aer = 341 + integer, parameter :: rid_SOAE_tau = 342 + integer, parameter :: rid_het1 = 343 + integer, parameter :: rid_het10 = 344 + integer, parameter :: rid_het11 = 345 + integer, parameter :: rid_het12 = 346 + integer, parameter :: rid_het13 = 347 + integer, parameter :: rid_het14 = 348 + integer, parameter :: rid_het15 = 349 + integer, parameter :: rid_het16 = 350 + integer, parameter :: rid_het17 = 351 + integer, parameter :: rid_het2 = 352 + integer, parameter :: rid_het3 = 353 + integer, parameter :: rid_het4 = 354 + integer, parameter :: rid_het5 = 355 + integer, parameter :: rid_het6 = 356 + integer, parameter :: rid_het7 = 357 + integer, parameter :: rid_het8 = 358 + integer, parameter :: rid_het9 = 359 + integer, parameter :: rid_E90_tau = 360 + integer, parameter :: rid_NH_50_tau = 361 + integer, parameter :: rid_NH_5_tau = 362 + integer, parameter :: rid_ST80_25_tau = 363 + end module m_rxt_id diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/m_spc_id.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/m_spc_id.F90 new file mode 100644 index 0000000000..83897dbc50 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/m_spc_id.F90 @@ -0,0 +1,144 @@ + module m_spc_id + implicit none + integer, parameter :: id_bc_a1 = 1 + integer, parameter :: id_bc_a4 = 2 + integer, parameter :: id_BIGALK = 3 + integer, parameter :: id_BR = 4 + integer, parameter :: id_BRCL = 5 + integer, parameter :: id_BRO = 6 + integer, parameter :: id_BRONO2 = 7 + integer, parameter :: id_BRY = 8 + integer, parameter :: id_C2H4 = 9 + integer, parameter :: id_C2H5OH = 10 + integer, parameter :: id_C2H5OOH = 11 + integer, parameter :: id_C2H6 = 12 + integer, parameter :: id_C3H6 = 13 + integer, parameter :: id_C3H7OOH = 14 + integer, parameter :: id_C3H8 = 15 + integer, parameter :: id_CCL4 = 16 + integer, parameter :: id_CF2CLBR = 17 + integer, parameter :: id_CF3BR = 18 + integer, parameter :: id_CFC11 = 19 + integer, parameter :: id_CFC113 = 20 + integer, parameter :: id_CFC114 = 21 + integer, parameter :: id_CFC115 = 22 + integer, parameter :: id_CFC12 = 23 + integer, parameter :: id_CH2BR2 = 24 + integer, parameter :: id_CH2O = 25 + integer, parameter :: id_CH3BR = 26 + integer, parameter :: id_CH3CCL3 = 27 + integer, parameter :: id_CH3CHO = 28 + integer, parameter :: id_CH3CL = 29 + integer, parameter :: id_CH3COCH3 = 30 + integer, parameter :: id_CH3COCHO = 31 + integer, parameter :: id_CH3COOH = 32 + integer, parameter :: id_CH3COOOH = 33 + integer, parameter :: id_CH3OH = 34 + integer, parameter :: id_CH3OOH = 35 + integer, parameter :: id_CH4 = 36 + integer, parameter :: id_CHBR3 = 37 + integer, parameter :: id_CL = 38 + integer, parameter :: id_CL2 = 39 + integer, parameter :: id_CL2O2 = 40 + integer, parameter :: id_CLO = 41 + integer, parameter :: id_CLONO2 = 42 + integer, parameter :: id_CLY = 43 + integer, parameter :: id_CO = 44 + integer, parameter :: id_CO2 = 45 + integer, parameter :: id_DMS = 46 + integer, parameter :: id_dst_a1 = 47 + integer, parameter :: id_dst_a2 = 48 + integer, parameter :: id_dst_a3 = 49 + integer, parameter :: id_E90 = 50 + integer, parameter :: id_EOOH = 51 + integer, parameter :: id_GLYALD = 52 + integer, parameter :: id_GLYOXAL = 53 + integer, parameter :: id_H = 54 + integer, parameter :: id_H2 = 55 + integer, parameter :: id_H2402 = 56 + integer, parameter :: id_H2O2 = 57 + integer, parameter :: id_H2SO4 = 58 + integer, parameter :: id_HBR = 59 + integer, parameter :: id_HCFC141B = 60 + integer, parameter :: id_HCFC142B = 61 + integer, parameter :: id_HCFC22 = 62 + integer, parameter :: id_HCL = 63 + integer, parameter :: id_HF = 64 + integer, parameter :: id_HNO3 = 65 + integer, parameter :: id_HO2NO2 = 66 + integer, parameter :: id_HOBR = 67 + integer, parameter :: id_HOCL = 68 + integer, parameter :: id_HYAC = 69 + integer, parameter :: id_HYDRALD = 70 + integer, parameter :: id_ISOP = 71 + integer, parameter :: id_ISOPNO3 = 72 + integer, parameter :: id_ISOPOOH = 73 + integer, parameter :: id_MACR = 74 + integer, parameter :: id_MACROOH = 75 + integer, parameter :: id_MPAN = 76 + integer, parameter :: id_MVK = 77 + integer, parameter :: id_N = 78 + integer, parameter :: id_N2O = 79 + integer, parameter :: id_N2O5 = 80 + integer, parameter :: id_ncl_a1 = 81 + integer, parameter :: id_ncl_a2 = 82 + integer, parameter :: id_ncl_a3 = 83 + integer, parameter :: id_NH3 = 84 + integer, parameter :: id_NH4 = 85 + integer, parameter :: id_NH_5 = 86 + integer, parameter :: id_NH_50 = 87 + integer, parameter :: id_NO = 88 + integer, parameter :: id_NO2 = 89 + integer, parameter :: id_NO3 = 90 + integer, parameter :: id_NOA = 91 + integer, parameter :: id_num_a1 = 92 + integer, parameter :: id_num_a2 = 93 + integer, parameter :: id_num_a3 = 94 + integer, parameter :: id_num_a4 = 95 + integer, parameter :: id_num_a5 = 96 + integer, parameter :: id_O = 97 + integer, parameter :: id_O3 = 98 + integer, parameter :: id_O3S = 99 + integer, parameter :: id_OCLO = 100 + integer, parameter :: id_OCS = 101 + integer, parameter :: id_ONITR = 102 + integer, parameter :: id_PAN = 103 + integer, parameter :: id_pom_a1 = 104 + integer, parameter :: id_pom_a4 = 105 + integer, parameter :: id_POOH = 106 + integer, parameter :: id_ROOH = 107 + integer, parameter :: id_S = 108 + integer, parameter :: id_SF6 = 109 + integer, parameter :: id_SO = 110 + integer, parameter :: id_SO2 = 111 + integer, parameter :: id_SO3 = 112 + integer, parameter :: id_so4_a1 = 113 + integer, parameter :: id_so4_a2 = 114 + integer, parameter :: id_so4_a3 = 115 + integer, parameter :: id_so4_a5 = 116 + integer, parameter :: id_soa_a1 = 117 + integer, parameter :: id_soa_a2 = 118 + integer, parameter :: id_SOAE = 119 + integer, parameter :: id_SOAG = 120 + integer, parameter :: id_ST80_25 = 121 + integer, parameter :: id_TERP = 122 + integer, parameter :: id_XOOH = 123 + integer, parameter :: id_NHDEP = 124 + integer, parameter :: id_NDEP = 125 + integer, parameter :: id_C2H5O2 = 126 + integer, parameter :: id_C3H7O2 = 127 + integer, parameter :: id_CH3CO3 = 128 + integer, parameter :: id_CH3O2 = 129 + integer, parameter :: id_EO = 130 + integer, parameter :: id_EO2 = 131 + integer, parameter :: id_HO2 = 132 + integer, parameter :: id_ISOPO2 = 133 + integer, parameter :: id_MACRO2 = 134 + integer, parameter :: id_MCO3 = 135 + integer, parameter :: id_O1D = 136 + integer, parameter :: id_OH = 137 + integer, parameter :: id_PO2 = 138 + integer, parameter :: id_RO2 = 139 + integer, parameter :: id_XO2 = 140 + integer, parameter :: id_H2O = 141 + end module m_spc_id diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_adjrxt.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_adjrxt.F90 new file mode 100644 index 0000000000..b8fc745806 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_adjrxt.F90 @@ -0,0 +1,291 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) + rate(:,:, 88) = rate(:,:, 88) * inv(:,:, 3) + rate(:,:, 89) = rate(:,:, 89) * inv(:,:, 2) + rate(:,:, 93) = rate(:,:, 93) * inv(:,:, 1) + rate(:,:, 110) = rate(:,:, 110) * inv(:,:, 1) + rate(:,:, 117) = rate(:,:, 117) * inv(:,:, 2) + rate(:,:, 120) = rate(:,:, 120) * inv(:,:, 1) + rate(:,:, 128) = rate(:,:, 128) * inv(:,:, 1) + rate(:,:, 131) = rate(:,:, 131) * inv(:,:, 1) + rate(:,:, 132) = rate(:,:, 132) * inv(:,:, 1) + rate(:,:, 133) = rate(:,:, 133) * inv(:,:, 1) + rate(:,:, 135) = rate(:,:, 135) * inv(:,:, 1) + rate(:,:, 136) = rate(:,:, 136) * inv(:,:, 1) + rate(:,:, 151) = rate(:,:, 151) * inv(:,:, 1) + rate(:,:, 171) = rate(:,:, 171) * inv(:,:, 1) + rate(:,:, 172) = rate(:,:, 172) * inv(:,:, 1) + rate(:,:, 182) = rate(:,:, 182) * inv(:,:, 1) + rate(:,:, 225) = rate(:,:, 225) * inv(:,:, 1) + rate(:,:, 246) = rate(:,:, 246) * inv(:,:, 2) + rate(:,:, 250) = rate(:,:, 250) * inv(:,:, 1) + rate(:,:, 251) = rate(:,:, 251) * inv(:,:, 1) + rate(:,:, 252) = rate(:,:, 252) * inv(:,:, 1) + rate(:,:, 271) = rate(:,:, 271) * inv(:,:, 1) + rate(:,:, 288) = rate(:,:, 288) * inv(:,:, 1) + rate(:,:, 291) = rate(:,:, 291) * inv(:,:, 1) + rate(:,:, 292) = rate(:,:, 292) * inv(:,:, 1) + rate(:,:, 322) = rate(:,:, 322) * inv(:,:, 2) + rate(:,:, 323) = rate(:,:, 323) * inv(:,:, 1) + rate(:,:, 329) = rate(:,:, 329) * inv(:,:, 2) + rate(:,:, 94) = rate(:,:, 94) * inv(:,:, 2) * inv(:,:, 1) + rate(:,:, 100) = rate(:,:, 100) * inv(:,:, 2) * inv(:,:, 1) + rate(:,:, 86) = rate(:,:, 86) * m(:,:) + rate(:,:, 87) = rate(:,:, 87) * m(:,:) + rate(:,:, 90) = rate(:,:, 90) * m(:,:) + rate(:,:, 91) = rate(:,:, 91) * m(:,:) + rate(:,:, 92) = rate(:,:, 92) * m(:,:) + rate(:,:, 93) = rate(:,:, 93) * m(:,:) + rate(:,:, 95) = rate(:,:, 95) * m(:,:) + rate(:,:, 96) = rate(:,:, 96) * m(:,:) + rate(:,:, 97) = rate(:,:, 97) * m(:,:) + rate(:,:, 98) = rate(:,:, 98) * m(:,:) + rate(:,:, 99) = rate(:,:, 99) * m(:,:) + rate(:,:, 101) = rate(:,:, 101) * m(:,:) + rate(:,:, 102) = rate(:,:, 102) * m(:,:) + rate(:,:, 103) = rate(:,:, 103) * m(:,:) + rate(:,:, 104) = rate(:,:, 104) * m(:,:) + rate(:,:, 105) = rate(:,:, 105) * m(:,:) + rate(:,:, 106) = rate(:,:, 106) * m(:,:) + rate(:,:, 107) = rate(:,:, 107) * m(:,:) + rate(:,:, 108) = rate(:,:, 108) * m(:,:) + rate(:,:, 109) = rate(:,:, 109) * m(:,:) + rate(:,:, 110) = rate(:,:, 110) * m(:,:) + rate(:,:, 111) = rate(:,:, 111) * m(:,:) + rate(:,:, 112) = rate(:,:, 112) * m(:,:) + rate(:,:, 113) = rate(:,:, 113) * m(:,:) + rate(:,:, 114) = rate(:,:, 114) * m(:,:) + rate(:,:, 115) = rate(:,:, 115) * m(:,:) + rate(:,:, 116) = rate(:,:, 116) * m(:,:) + rate(:,:, 118) = rate(:,:, 118) * m(:,:) + rate(:,:, 119) = rate(:,:, 119) * m(:,:) + rate(:,:, 120) = rate(:,:, 120) * m(:,:) + rate(:,:, 121) = rate(:,:, 121) * m(:,:) + rate(:,:, 122) = rate(:,:, 122) * m(:,:) + rate(:,:, 123) = rate(:,:, 123) * m(:,:) + rate(:,:, 124) = rate(:,:, 124) * m(:,:) + rate(:,:, 125) = rate(:,:, 125) * m(:,:) + rate(:,:, 126) = rate(:,:, 126) * m(:,:) + rate(:,:, 127) = rate(:,:, 127) * m(:,:) + rate(:,:, 128) = rate(:,:, 128) * m(:,:) + rate(:,:, 129) = rate(:,:, 129) * m(:,:) + rate(:,:, 130) = rate(:,:, 130) * m(:,:) + rate(:,:, 131) = rate(:,:, 131) * m(:,:) + rate(:,:, 132) = rate(:,:, 132) * m(:,:) + rate(:,:, 133) = rate(:,:, 133) * m(:,:) + rate(:,:, 134) = rate(:,:, 134) * m(:,:) + rate(:,:, 137) = rate(:,:, 137) * m(:,:) + rate(:,:, 138) = rate(:,:, 138) * m(:,:) + rate(:,:, 139) = rate(:,:, 139) * m(:,:) + rate(:,:, 140) = rate(:,:, 140) * m(:,:) + rate(:,:, 141) = rate(:,:, 141) * m(:,:) + rate(:,:, 142) = rate(:,:, 142) * m(:,:) + rate(:,:, 143) = rate(:,:, 143) * m(:,:) + rate(:,:, 144) = rate(:,:, 144) * m(:,:) + rate(:,:, 145) = rate(:,:, 145) * m(:,:) + rate(:,:, 146) = rate(:,:, 146) * m(:,:) + rate(:,:, 147) = rate(:,:, 147) * m(:,:) + rate(:,:, 148) = rate(:,:, 148) * m(:,:) + rate(:,:, 149) = rate(:,:, 149) * m(:,:) + rate(:,:, 150) = rate(:,:, 150) * m(:,:) + rate(:,:, 151) = rate(:,:, 151) * m(:,:) + rate(:,:, 152) = rate(:,:, 152) * m(:,:) + rate(:,:, 153) = rate(:,:, 153) * m(:,:) + rate(:,:, 154) = rate(:,:, 154) * m(:,:) + rate(:,:, 155) = rate(:,:, 155) * m(:,:) + rate(:,:, 156) = rate(:,:, 156) * m(:,:) + rate(:,:, 157) = rate(:,:, 157) * m(:,:) + rate(:,:, 158) = rate(:,:, 158) * m(:,:) + rate(:,:, 159) = rate(:,:, 159) * m(:,:) + rate(:,:, 160) = rate(:,:, 160) * m(:,:) + rate(:,:, 161) = rate(:,:, 161) * m(:,:) + rate(:,:, 162) = rate(:,:, 162) * m(:,:) + rate(:,:, 163) = rate(:,:, 163) * m(:,:) + rate(:,:, 164) = rate(:,:, 164) * m(:,:) + rate(:,:, 165) = rate(:,:, 165) * m(:,:) + rate(:,:, 166) = rate(:,:, 166) * m(:,:) + rate(:,:, 167) = rate(:,:, 167) * m(:,:) + rate(:,:, 168) = rate(:,:, 168) * m(:,:) + rate(:,:, 169) = rate(:,:, 169) * m(:,:) + rate(:,:, 170) = rate(:,:, 170) * m(:,:) + rate(:,:, 171) = rate(:,:, 171) * m(:,:) + rate(:,:, 173) = rate(:,:, 173) * m(:,:) + rate(:,:, 174) = rate(:,:, 174) * m(:,:) + rate(:,:, 175) = rate(:,:, 175) * m(:,:) + rate(:,:, 176) = rate(:,:, 176) * m(:,:) + rate(:,:, 177) = rate(:,:, 177) * m(:,:) + rate(:,:, 178) = rate(:,:, 178) * m(:,:) + rate(:,:, 179) = rate(:,:, 179) * m(:,:) + rate(:,:, 180) = rate(:,:, 180) * m(:,:) + rate(:,:, 181) = rate(:,:, 181) * m(:,:) + rate(:,:, 182) = rate(:,:, 182) * m(:,:) + rate(:,:, 183) = rate(:,:, 183) * m(:,:) + rate(:,:, 184) = rate(:,:, 184) * m(:,:) + rate(:,:, 185) = rate(:,:, 185) * m(:,:) + rate(:,:, 186) = rate(:,:, 186) * m(:,:) + rate(:,:, 187) = rate(:,:, 187) * m(:,:) + rate(:,:, 188) = rate(:,:, 188) * m(:,:) + rate(:,:, 189) = rate(:,:, 189) * m(:,:) + rate(:,:, 190) = rate(:,:, 190) * m(:,:) + rate(:,:, 191) = rate(:,:, 191) * m(:,:) + rate(:,:, 192) = rate(:,:, 192) * m(:,:) + rate(:,:, 193) = rate(:,:, 193) * m(:,:) + rate(:,:, 194) = rate(:,:, 194) * m(:,:) + rate(:,:, 195) = rate(:,:, 195) * m(:,:) + rate(:,:, 196) = rate(:,:, 196) * m(:,:) + rate(:,:, 197) = rate(:,:, 197) * m(:,:) + rate(:,:, 198) = rate(:,:, 198) * m(:,:) + rate(:,:, 199) = rate(:,:, 199) * m(:,:) + rate(:,:, 200) = rate(:,:, 200) * m(:,:) + rate(:,:, 201) = rate(:,:, 201) * m(:,:) + rate(:,:, 202) = rate(:,:, 202) * m(:,:) + rate(:,:, 203) = rate(:,:, 203) * m(:,:) + rate(:,:, 204) = rate(:,:, 204) * m(:,:) + rate(:,:, 205) = rate(:,:, 205) * m(:,:) + rate(:,:, 206) = rate(:,:, 206) * m(:,:) + rate(:,:, 207) = rate(:,:, 207) * m(:,:) + rate(:,:, 208) = rate(:,:, 208) * m(:,:) + rate(:,:, 209) = rate(:,:, 209) * m(:,:) + rate(:,:, 210) = rate(:,:, 210) * m(:,:) + rate(:,:, 211) = rate(:,:, 211) * m(:,:) + rate(:,:, 212) = rate(:,:, 212) * m(:,:) + rate(:,:, 213) = rate(:,:, 213) * m(:,:) + rate(:,:, 214) = rate(:,:, 214) * m(:,:) + rate(:,:, 215) = rate(:,:, 215) * m(:,:) + rate(:,:, 216) = rate(:,:, 216) * m(:,:) + rate(:,:, 217) = rate(:,:, 217) * m(:,:) + rate(:,:, 218) = rate(:,:, 218) * m(:,:) + rate(:,:, 219) = rate(:,:, 219) * m(:,:) + rate(:,:, 220) = rate(:,:, 220) * m(:,:) + rate(:,:, 221) = rate(:,:, 221) * m(:,:) + rate(:,:, 222) = rate(:,:, 222) * m(:,:) + rate(:,:, 223) = rate(:,:, 223) * m(:,:) + rate(:,:, 224) = rate(:,:, 224) * m(:,:) + rate(:,:, 225) = rate(:,:, 225) * m(:,:) + rate(:,:, 226) = rate(:,:, 226) * m(:,:) + rate(:,:, 227) = rate(:,:, 227) * m(:,:) + rate(:,:, 228) = rate(:,:, 228) * m(:,:) + rate(:,:, 229) = rate(:,:, 229) * m(:,:) + rate(:,:, 230) = rate(:,:, 230) * m(:,:) + rate(:,:, 231) = rate(:,:, 231) * m(:,:) + rate(:,:, 232) = rate(:,:, 232) * m(:,:) + rate(:,:, 233) = rate(:,:, 233) * m(:,:) + rate(:,:, 234) = rate(:,:, 234) * m(:,:) + rate(:,:, 235) = rate(:,:, 235) * m(:,:) + rate(:,:, 236) = rate(:,:, 236) * m(:,:) + rate(:,:, 237) = rate(:,:, 237) * m(:,:) + rate(:,:, 238) = rate(:,:, 238) * m(:,:) + rate(:,:, 239) = rate(:,:, 239) * m(:,:) + rate(:,:, 240) = rate(:,:, 240) * m(:,:) + rate(:,:, 241) = rate(:,:, 241) * m(:,:) + rate(:,:, 242) = rate(:,:, 242) * m(:,:) + rate(:,:, 243) = rate(:,:, 243) * m(:,:) + rate(:,:, 244) = rate(:,:, 244) * m(:,:) + rate(:,:, 247) = rate(:,:, 247) * m(:,:) + rate(:,:, 248) = rate(:,:, 248) * m(:,:) + rate(:,:, 249) = rate(:,:, 249) * m(:,:) + rate(:,:, 250) = rate(:,:, 250) * m(:,:) + rate(:,:, 251) = rate(:,:, 251) * m(:,:) + rate(:,:, 253) = rate(:,:, 253) * m(:,:) + rate(:,:, 254) = rate(:,:, 254) * m(:,:) + rate(:,:, 255) = rate(:,:, 255) * m(:,:) + rate(:,:, 256) = rate(:,:, 256) * m(:,:) + rate(:,:, 257) = rate(:,:, 257) * m(:,:) + rate(:,:, 258) = rate(:,:, 258) * m(:,:) + rate(:,:, 259) = rate(:,:, 259) * m(:,:) + rate(:,:, 260) = rate(:,:, 260) * m(:,:) + rate(:,:, 261) = rate(:,:, 261) * m(:,:) + rate(:,:, 262) = rate(:,:, 262) * m(:,:) + rate(:,:, 263) = rate(:,:, 263) * m(:,:) + rate(:,:, 264) = rate(:,:, 264) * m(:,:) + rate(:,:, 265) = rate(:,:, 265) * m(:,:) + rate(:,:, 266) = rate(:,:, 266) * m(:,:) + rate(:,:, 267) = rate(:,:, 267) * m(:,:) + rate(:,:, 268) = rate(:,:, 268) * m(:,:) + rate(:,:, 269) = rate(:,:, 269) * m(:,:) + rate(:,:, 270) = rate(:,:, 270) * m(:,:) + rate(:,:, 271) = rate(:,:, 271) * m(:,:) + rate(:,:, 272) = rate(:,:, 272) * m(:,:) + rate(:,:, 273) = rate(:,:, 273) * m(:,:) + rate(:,:, 274) = rate(:,:, 274) * m(:,:) + rate(:,:, 275) = rate(:,:, 275) * m(:,:) + rate(:,:, 276) = rate(:,:, 276) * m(:,:) + rate(:,:, 277) = rate(:,:, 277) * m(:,:) + rate(:,:, 278) = rate(:,:, 278) * m(:,:) + rate(:,:, 279) = rate(:,:, 279) * m(:,:) + rate(:,:, 280) = rate(:,:, 280) * m(:,:) + rate(:,:, 281) = rate(:,:, 281) * m(:,:) + rate(:,:, 282) = rate(:,:, 282) * m(:,:) + rate(:,:, 283) = rate(:,:, 283) * m(:,:) + rate(:,:, 284) = rate(:,:, 284) * m(:,:) + rate(:,:, 285) = rate(:,:, 285) * m(:,:) + rate(:,:, 286) = rate(:,:, 286) * m(:,:) + rate(:,:, 287) = rate(:,:, 287) * m(:,:) + rate(:,:, 288) = rate(:,:, 288) * m(:,:) + rate(:,:, 289) = rate(:,:, 289) * m(:,:) + rate(:,:, 290) = rate(:,:, 290) * m(:,:) + rate(:,:, 291) = rate(:,:, 291) * m(:,:) + rate(:,:, 293) = rate(:,:, 293) * m(:,:) + rate(:,:, 294) = rate(:,:, 294) * m(:,:) + rate(:,:, 295) = rate(:,:, 295) * m(:,:) + rate(:,:, 296) = rate(:,:, 296) * m(:,:) + rate(:,:, 297) = rate(:,:, 297) * m(:,:) + rate(:,:, 298) = rate(:,:, 298) * m(:,:) + rate(:,:, 299) = rate(:,:, 299) * m(:,:) + rate(:,:, 300) = rate(:,:, 300) * m(:,:) + rate(:,:, 301) = rate(:,:, 301) * m(:,:) + rate(:,:, 302) = rate(:,:, 302) * m(:,:) + rate(:,:, 303) = rate(:,:, 303) * m(:,:) + rate(:,:, 304) = rate(:,:, 304) * m(:,:) + rate(:,:, 305) = rate(:,:, 305) * m(:,:) + rate(:,:, 306) = rate(:,:, 306) * m(:,:) + rate(:,:, 307) = rate(:,:, 307) * m(:,:) + rate(:,:, 308) = rate(:,:, 308) * m(:,:) + rate(:,:, 309) = rate(:,:, 309) * m(:,:) + rate(:,:, 310) = rate(:,:, 310) * m(:,:) + rate(:,:, 311) = rate(:,:, 311) * m(:,:) + rate(:,:, 312) = rate(:,:, 312) * m(:,:) + rate(:,:, 313) = rate(:,:, 313) * m(:,:) + rate(:,:, 314) = rate(:,:, 314) * m(:,:) + rate(:,:, 315) = rate(:,:, 315) * m(:,:) + rate(:,:, 316) = rate(:,:, 316) * m(:,:) + rate(:,:, 317) = rate(:,:, 317) * m(:,:) + rate(:,:, 318) = rate(:,:, 318) * m(:,:) + rate(:,:, 319) = rate(:,:, 319) * m(:,:) + rate(:,:, 320) = rate(:,:, 320) * m(:,:) + rate(:,:, 321) = rate(:,:, 321) * m(:,:) + rate(:,:, 323) = rate(:,:, 323) * m(:,:) + rate(:,:, 324) = rate(:,:, 324) * m(:,:) + rate(:,:, 325) = rate(:,:, 325) * m(:,:) + rate(:,:, 326) = rate(:,:, 326) * m(:,:) + rate(:,:, 327) = rate(:,:, 327) * m(:,:) + rate(:,:, 328) = rate(:,:, 328) * m(:,:) + rate(:,:, 330) = rate(:,:, 330) * m(:,:) + rate(:,:, 331) = rate(:,:, 331) * m(:,:) + rate(:,:, 332) = rate(:,:, 332) * m(:,:) + rate(:,:, 333) = rate(:,:, 333) * m(:,:) + rate(:,:, 334) = rate(:,:, 334) * m(:,:) + rate(:,:, 335) = rate(:,:, 335) * m(:,:) + rate(:,:, 344) = rate(:,:, 344) * m(:,:) + rate(:,:, 349) = rate(:,:, 349) * m(:,:) + rate(:,:, 350) = rate(:,:, 350) * m(:,:) + rate(:,:, 351) = rate(:,:, 351) * m(:,:) + rate(:,:, 354) = rate(:,:, 354) * m(:,:) + rate(:,:, 355) = rate(:,:, 355) * m(:,:) + rate(:,:, 356) = rate(:,:, 356) * m(:,:) + rate(:,:, 359) = rate(:,:, 359) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_exp_sol.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_exp_sol.F90 new file mode 100644 index 0000000000..c1cde93fa7 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_exp_sol.F90 @@ -0,0 +1,81 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + integer :: chnkpnts + real(r8), dimension(ncol,pver,max(1,clscnt1)) :: & + prod, & + loss + real(r8), dimension(ncol,pver,clscnt1) :: ind_prd + real(r8), dimension(ncol,pver) :: wrk + chnkpnts = ncol*pver + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, chnkpnts ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( 1, chnkpnts, prod, loss, base_sol, reaction_rates, & + het_rates, chnkpnts ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_imp_sol.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_imp_sol.F90 new file mode 100644 index 0000000000..98cadb9050 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_imp_sol.F90 @@ -0,0 +1,435 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap, veclen + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: sol_min = 1.e-20_r8 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol, nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for vector architectures such as the + ! nec sx6 and cray x1 + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol*nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol*nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol*nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol*nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol*nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol*nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter + integer :: ofl + integer :: ofu + integer :: avec_len + integer :: bndx ! base index + integer :: cndx ! class index + integer :: pndx ! permuted class index + integer :: i,m + integer :: fail_cnt(veclen) + integer :: cut_cnt(veclen) + integer :: stp_con_cnt(veclen) + integer :: nstep + real(r8) :: interval_done(veclen) + real(r8) :: dt(veclen) + real(r8) :: dti(veclen) + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: ind_prd(ncol*nlev,max(1,clscnt4)) + logical :: convergence + integer :: chnkpnts ! total spatial points in chunk; ncol*ncol + logical :: diags_out(ncol*nlev,max(1,clscnt4)) + real(r8) :: sys_jac_blk(veclen,max(1,nzcnt)) + real(r8) :: lin_jac_blk(veclen,max(1,nzcnt)) + real(r8) :: solution_blk(veclen,max(1,clscnt4)) + real(r8) :: forcing_blk(veclen,max(1,clscnt4)) + real(r8) :: iter_invariant_blk(veclen,max(1,clscnt4)) + real(r8) :: prod_blk(veclen,max(1,clscnt4)) + real(r8) :: loss_blk(veclen,max(1,clscnt4)) + real(r8) :: ind_prd_blk(veclen,max(1,clscnt4)) + real(r8) :: sbase_sol_blk(veclen,gas_pcnst) + real(r8) :: wrk_blk(veclen) + logical :: spc_conv_blk(veclen,max(1,clscnt4)) + logical :: cls_conv_blk(veclen) + logical :: time_stp_done_blk(veclen) + real(r8) :: reaction_rates_blk(veclen,max(1,rxntot)) + real(r8) :: extfrc_blk(veclen,max(1,extcnt)) + real(r8) :: het_rates_blk(veclen,max(1,gas_pcnst)) + real(r8) :: base_sol_blk(veclen,gas_pcnst) + chnkpnts = ncol*nlev + prod_out = 0._r8 + loss_out = 0._r8 + diags_out = .false. + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, chnkpnts ) + else + do m = 1,clscnt4 + ind_prd(:,m) = 0._r8 + end do + end if + nstep = get_nstep() + ofl = 1 + chnkpnts_loop : do + ofu = min( chnkpnts,ofl + veclen - 1 ) + avec_len = (ofu - ofl) + 1 + reaction_rates_blk(1:avec_len,:) = reaction_rates(ofl:ofu,:) + extfrc_blk(1:avec_len,:) = extfrc(ofl:ofu,:) + het_rates_blk(1:avec_len,:) = het_rates(ofl:ofu,:) + ind_prd_blk(1:avec_len,:) = ind_prd(ofl:ofu,:) + base_sol_blk(1:avec_len,:) = base_sol(ofl:ofu,:) + cls_conv_blk(1:avec_len) = .false. + dt(1:avec_len) = delt + cut_cnt(1:avec_len) = 0 + fail_cnt(1:avec_len) = 0 + stp_con_cnt(1:avec_len) = 0 + interval_done(1:avec_len) = 0._r8 + time_stp_done_blk(1:avec_len) = .false. + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + time_step_loop : do + dti(1:avec_len) = 1._r8 / dt(1:avec_len) + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do cndx = 1,clscnt4 + bndx = clsmap(cndx,4) + pndx = permute(cndx,4) + do i = 1, avec_len + solution_blk(i,pndx) = base_sol_blk(i,bndx) + end do + end do + do m = 1,gas_pcnst + sbase_sol_blk(1:avec_len,m) = base_sol_blk(1:avec_len,m) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + do i = 1, avec_len + iter_invariant_blk(i,m) = dti(i) * solution_blk(i,m) + ind_prd_blk(i,m) + end do + end do + else + do m = 1,clscnt4 + do i = 1, avec_len + iter_invariant_blk(i,m) = dti(i) * solution_blk(i,m) + end do + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( avec_len, lin_jac_blk, base_sol_blk, & + reaction_rates_blk, het_rates_blk ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( avec_len, sys_jac_blk, base_sol_blk, & + reaction_rates_blk, lin_jac_blk, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( avec_len, sys_jac_blk ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( avec_len, prod_blk, loss_blk, & + base_sol_blk, reaction_rates_blk, het_rates_blk ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + do i = 1, avec_len + forcing_blk(i,m) = solution_blk(i,m)*dti(i) & + - (iter_invariant_blk(i,m) + prod_blk(i,m) - loss_blk(i,m)) + end do + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( avec_len, sys_jac_blk, forcing_blk ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + do i = 1, avec_len + if( .not. cls_conv_blk(i) )then + solution_blk(i,m) = solution_blk(i,m) + forcing_blk(i,m) + else + forcing_blk(i,m) = 0._r8 + endif + end do + end do + !----------------------------------------------------------------------- + ! ... convergence measures and test + !----------------------------------------------------------------------- + conv_chk : if( nr_iter > 1 ) then + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + do cndx = 1,clscnt4 + pndx = permute(cndx,4) + bndx = clsmap(cndx,4) + do i = 1, avec_len + if ( abs( solution_blk(i,pndx) ) > sol_min ) then + wrk_blk(i) = abs( forcing_blk(i,pndx)/solution_blk(i,pndx) ) + else + wrk_blk(i) = 0._r8 + endif + enddo + max_delta(cndx) = maxval( wrk_blk(1:avec_len) ) + do i = 1, avec_len + solution_blk(i,pndx) = max( 0._r8,solution_blk(i,pndx) ) + base_sol_blk(i,bndx) = solution_blk(i,pndx) + if ( abs( forcing_blk(i,pndx) ) > small ) then + spc_conv_blk(i,cndx) = abs(forcing_blk(i,pndx)) <= epsilon(cndx)*abs(solution_blk(i,pndx)) + else + spc_conv_blk(i,cndx) = .true. + endif + enddo + where( spc_conv_blk(1:avec_len,cndx) .and. .not.diags_out(ofl:ofu,cndx) ) + ! capture output production and loss diagnostics at converged ponits + prod_out(ofl:ofu,cndx) = prod_blk(1:avec_len,cndx) + ind_prd_blk(1:avec_len,cndx) + loss_out(ofl:ofu,cndx) = loss_blk(1:avec_len,cndx) + diags_out(ofl:ofu,cndx) = .true. + endwhere + end do + do i = 1, avec_len + if( .not. cls_conv_blk(i) ) then + cls_conv_blk(i) = all( spc_conv_blk(i,:) ) + end if + end do + convergence = all( cls_conv_blk(:) ) + if( convergence ) then + exit iter_loop + end if + else conv_chk +!----------------------------------------------------------------------- +! ... limit iterate +!----------------------------------------------------------------------- + do m = 1,clscnt4 + do i = 1, avec_len + solution_blk(i,m) = max( 0._r8,solution_blk(i,m) ) + end do + end do +!----------------------------------------------------------------------- +! ... transfer latest solution back to base array +!----------------------------------------------------------------------- + do cndx = 1,clscnt4 + pndx = permute(cndx,4) + bndx = clsmap(cndx,4) + do i = 1, avec_len + base_sol_blk(i,bndx) = solution_blk(i,pndx) + end do + end do + end if conv_chk + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + do i = 1,avec_len + if( .not. cls_conv_blk(i) ) then + fail_cnt(i) = fail_cnt(i) + 1 + write(iulog,'('' imp_sol: time step '',1p,g15.7,'' failed to converge @ (lchnk,vctrpos,nstep) = '',3i8)') & + dt(i),lchnk,ofl+i-1,nstep + stp_con_cnt(i) = 0 + if( cut_cnt(i) < cut_limit ) then + cut_cnt(i) = cut_cnt(i) + 1 + if( cut_cnt(i) < cut_limit ) then + dt(i) = .5_r8 * dt(i) + else + dt(i) = .1_r8 * dt(i) + end if + base_sol_blk(i,:) = sbase_sol_blk(i,:) + else + write(iulog,'('' imp_sol: step failed to converge @ (lchnk,vctrpos,nstep,dt,time) = '',3i8,1p,2g15.7)') & + lchnk,ofl+i-1,nstep,dt(i),interval_done+dt(i) + do m = 1,clscnt4 + if( .not. spc_conv_blk(i,m) ) then + write(iulog,'(1x,a16,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + cls_conv_blk(i) = .true. + if( .not. time_stp_done_blk(i) ) then + interval_done(i) = interval_done(i) + dt(i) + time_stp_done_blk(i) = abs( delt - interval_done(i) ) <= .0001_r8 + endif + end if + elseif( .not. time_stp_done_blk(i) ) then + interval_done(i) = interval_done(i) + dt(i) + time_stp_done_blk(i) = abs( delt - interval_done(i) ) <= .0001_r8 + stp_con_cnt(i) = stp_con_cnt(i) + 1 + if( .not. time_stp_done_blk(i) ) then + if( stp_con_cnt(i) >= 2 ) then + dt(i) = 2._r8*dt(i) + stp_con_cnt(i) = 0 + end if + dt(i) = min( dt(i),delt-interval_done(i) ) + else + base_sol(ofl+i-1,1:gas_pcnst) = base_sol_blk(i,1:gas_pcnst) + endif + endif + end do + convergence = all( cls_conv_blk(:) ) + do i = 1,avec_len + if( cls_conv_blk(i) .and. .not. time_stp_done_blk(i) ) then + cls_conv_blk(i) = .false. + endif + end do + if( .not. convergence ) then + cycle time_step_loop + endif + !----------------------------------------------------------------------- + ! ... check for time step done + !----------------------------------------------------------------------- + if( all( time_stp_done_blk(1:avec_len) ) ) then + exit time_step_loop + end if + end do time_step_loop + ofl = ofu + 1 + if( ofl > chnkpnts ) then + exit chnkpnts_loop + end if + end do chnkpnts_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_indprd.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_indprd.F90 new file mode 100644 index 0000000000..e3a9106c2e --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_indprd.F90 @@ -0,0 +1,170 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, chnkpnts ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: chnkpnts + integer, intent(in) :: nprod + real(r8), intent(in) :: y(chnkpnts,gas_pcnst) + real(r8), intent(in) :: rxt(chnkpnts,rxntot) + real(r8), intent(in) :: extfrc(chnkpnts,extcnt) + real(r8), intent(inout) :: prod(chnkpnts,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Explicit species +!-------------------------------------------------------------------- + if( class == 1 ) then + prod(:,1) =rxt(:,335)*y(:,137)*y(:,84) +rxt(:,338)*y(:,85) + prod(:,2) =.500_r8*rxt(:,288)*y(:,137)*y(:,76) +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,1) = 0._r8 + prod(:,2) = + extfrc(:,7) + prod(:,35) = 0._r8 + prod(:,126) = 0._r8 + prod(:,56) = 0._r8 + prod(:,131) = 0._r8 + prod(:,83) = 0._r8 + prod(:,3) = 0._r8 + prod(:,76) = 0._r8 + prod(:,57) = 0._r8 + prod(:,64) = 0._r8 + prod(:,61) = 0._r8 + prod(:,112) = 0._r8 + prod(:,71) = 0._r8 + prod(:,45) = 0._r8 + prod(:,38) = 0._r8 + prod(:,46) = 0._r8 + prod(:,39) = 0._r8 + prod(:,40) = 0._r8 + prod(:,41) = 0._r8 + prod(:,42) = 0._r8 + prod(:,43) = 0._r8 + prod(:,44) = 0._r8 + prod(:,77) = 0._r8 + prod(:,125) = 0._r8 + prod(:,86) = 0._r8 + prod(:,47) = 0._r8 + prod(:,113) = 0._r8 + prod(:,68) = 0._r8 + prod(:,95) = 0._r8 + prod(:,116) = 0._r8 + prod(:,89) = 0._r8 + prod(:,87) = 0._r8 + prod(:,80) = 0._r8 + prod(:,73) = 0._r8 + prod(:,107) = 0._r8 + prod(:,70) = 0._r8 + prod(:,128) = 0._r8 + prod(:,50) = 0._r8 + prod(:,34) = 0._r8 + prod(:,137) = 0._r8 + prod(:,104) = 0._r8 + prod(:,4) = 0._r8 + prod(:,110) = 0._r8 + prod(:,90) = 0._r8 + prod(:,62) = 0._r8 + prod(:,5) = 0._r8 + prod(:,6) = 0._r8 + prod(:,7) = 0._r8 + prod(:,8) = 0._r8 + prod(:,48) = 0._r8 + prod(:,105) = 0._r8 + prod(:,92) = 0._r8 + prod(:,124) = 0._r8 + prod(:,111) = 0._r8 + prod(:,36) = 0._r8 + prod(:,84) = 0._r8 + prod(:,49) = 0._r8 + prod(:,100) = 0._r8 + prod(:,51) = 0._r8 + prod(:,52) = 0._r8 + prod(:,55) = 0._r8 + prod(:,127) = 0._r8 + prod(:,9) = 0._r8 + prod(:,101) = 0._r8 + prod(:,69) = 0._r8 + prod(:,94) = 0._r8 + prod(:,99) = 0._r8 + prod(:,109) = 0._r8 + prod(:,66) = 0._r8 + prod(:,103) = 0._r8 + prod(:,97) = 0._r8 + prod(:,79) = 0._r8 + prod(:,114) = 0._r8 + prod(:,63) = 0._r8 + prod(:,85) = 0._r8 + prod(:,122) = 0._r8 + prod(:,75) = 0._r8 + prod(:,53) = 0._r8 + prod(:,60) = 0._r8 + prod(:,10) = 0._r8 + prod(:,11) = 0._r8 + prod(:,12) = 0._r8 + prod(:,37) = 0._r8 + prod(:,13) = 0._r8 + prod(:,14) = 0._r8 + prod(:,15) = 0._r8 + prod(:,138) = + extfrc(:,9) + prod(:,133) = + extfrc(:,1) + prod(:,136) = 0._r8 + prod(:,72) = 0._r8 + prod(:,16) = + extfrc(:,6) + prod(:,17) = + extfrc(:,5) + prod(:,18) = 0._r8 + prod(:,19) = + extfrc(:,8) + prod(:,20) = 0._r8 + prod(:,129) = (rxt(:,5) +2.000_r8*rxt(:,6)) + prod(:,132) = 0._r8 + prod(:,21) = 0._r8 + prod(:,65) = 0._r8 + prod(:,67) = 0._r8 + prod(:,106) = 0._r8 + prod(:,81) = 0._r8 + prod(:,22) = 0._r8 + prod(:,23) = 0._r8 + prod(:,82) = 0._r8 + prod(:,74) = 0._r8 + prod(:,78) = 0._r8 + prod(:,24) = 0._r8 + prod(:,117) = 0._r8 + prod(:,102) = + extfrc(:,3) + prod(:,58) = 0._r8 + prod(:,25) = + extfrc(:,4) + prod(:,26) = + extfrc(:,2) + prod(:,27) = 0._r8 + prod(:,28) = 0._r8 + prod(:,29) = 0._r8 + prod(:,30) = 0._r8 + prod(:,31) = 0._r8 + prod(:,32) = 0._r8 + prod(:,33) = 0._r8 + prod(:,88) = 0._r8 + prod(:,54) = 0._r8 + prod(:,96) = 0._r8 + prod(:,98) = 0._r8 + prod(:,121) = 0._r8 + prod(:,123) = 0._r8 + prod(:,59) = 0._r8 + prod(:,91) = 0._r8 + prod(:,130) = 0._r8 + prod(:,118) = 0._r8 + prod(:,119) = 0._r8 + prod(:,120) = 0._r8 + prod(:,134) =rxt(:,5) + prod(:,135) = 0._r8 + prod(:,93) = 0._r8 + prod(:,108) = 0._r8 + prod(:,115) = 0._r8 + prod(:,139) = 0._r8 + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_lin_matrix.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_lin_matrix.F90 new file mode 100644 index 0000000000..e182d93817 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_lin_matrix.F90 @@ -0,0 +1,396 @@ + module mo_lin_matrix + use chem_mods, only: veclen + private + public :: linmat + contains + subroutine linmat01( avec_len, mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k + do k = 1,avec_len + mat(k,1) = -( het_rates(k,1) ) + mat(k,2) = -( het_rates(k,2) ) + mat(k,39) = -( het_rates(k,3) ) + mat(k,800) = -( het_rates(k,4) ) + mat(k,109) = rxt(k,46) + mat(k,961) = rxt(k,47) + mat(k,271) = rxt(k,49) + mat(k,74) = rxt(k,51) + mat(k,52) = rxt(k,52) + mat(k,228) = 2.000_r8*rxt(k,58) + mat(k,294) = rxt(k,59) + mat(k,183) = 3.000_r8*rxt(k,62) + mat(k,43) = 2.000_r8*rxt(k,68) + mat(k,410) = rxt(k,69) + mat(k,353) = rxt(k,75) + mat(k,108) = -( rxt(k,46) + het_rates(k,5) ) + mat(k,966) = -( rxt(k,47) + het_rates(k,6) ) + mat(k,273) = rxt(k,48) + mat(k,268) = -( rxt(k,48) + rxt(k,49) + rxt(k,345) + rxt(k,348) + rxt(k,353) & + + het_rates(k,7) ) + mat(k,3) = -( het_rates(k,8) ) + mat(k,220) = -( het_rates(k,9) ) + mat(k,111) = -( het_rates(k,10) ) + mat(k,147) = -( rxt(k,19) + het_rates(k,11) ) + mat(k,130) = -( het_rates(k,12) ) + mat(k,530) = -( het_rates(k,13) ) + mat(k,709) = .700_r8*rxt(k,39) + mat(k,188) = -( rxt(k,20) + het_rates(k,14) ) + mat(k,69) = -( het_rates(k,15) ) + mat(k,48) = -( rxt(k,50) + het_rates(k,16) ) + mat(k,73) = -( rxt(k,51) + het_rates(k,17) ) + mat(k,51) = -( rxt(k,52) + het_rates(k,18) ) + mat(k,54) = -( rxt(k,53) + het_rates(k,19) ) + mat(k,57) = -( rxt(k,54) + het_rates(k,20) ) + mat(k,60) = -( rxt(k,55) + het_rates(k,21) ) + mat(k,63) = -( rxt(k,56) + het_rates(k,22) ) + mat(k,66) = -( rxt(k,57) + het_rates(k,23) ) + mat(k,227) = -( rxt(k,58) + het_rates(k,24) ) + mat(k,783) = -( rxt(k,21) + rxt(k,22) + het_rates(k,25) ) + mat(k,203) = rxt(k,27) + mat(k,482) = .180_r8*rxt(k,28) + mat(k,461) = rxt(k,32) + mat(k,506) = rxt(k,34) + mat(k,245) = .690_r8*rxt(k,35) + mat(k,565) = 1.340_r8*rxt(k,36) + mat(k,197) = rxt(k,40) + mat(k,470) = rxt(k,41) + mat(k,264) = rxt(k,43) + mat(k,209) = rxt(k,44) + mat(k,122) = 2.000_r8*rxt(k,245) + mat(k,292) = -( rxt(k,59) + het_rates(k,26) ) + mat(k,77) = -( rxt(k,60) + het_rates(k,27) ) + mat(k,550) = -( rxt(k,23) + het_rates(k,28) ) + mat(k,149) = rxt(k,19) + mat(k,263) = rxt(k,43) + mat(k,168) = -( rxt(k,61) + het_rates(k,29) ) + mat(k,360) = -( rxt(k,24) + het_rates(k,30) ) + mat(k,189) = .820_r8*rxt(k,20) + mat(k,591) = -( rxt(k,25) + het_rates(k,31) ) + mat(k,318) = -( het_rates(k,32) ) + mat(k,301) = -( rxt(k,26) + het_rates(k,33) ) + mat(k,248) = -( het_rates(k,34) ) + mat(k,200) = -( rxt(k,27) + het_rates(k,35) ) + mat(k,477) = -( rxt(k,28) + rxt(k,29) + het_rates(k,36) ) + mat(k,182) = -( rxt(k,62) + het_rates(k,37) ) + mat(k,856) = -( het_rates(k,38) ) + mat(k,110) = rxt(k,46) + mat(k,49) = 4.000_r8*rxt(k,50) + mat(k,75) = rxt(k,51) + mat(k,55) = 3.000_r8*rxt(k,53) + mat(k,58) = 3.000_r8*rxt(k,54) + mat(k,61) = 2.000_r8*rxt(k,55) + mat(k,64) = rxt(k,56) + mat(k,67) = 2.000_r8*rxt(k,57) + mat(k,78) = 3.000_r8*rxt(k,60) + mat(k,172) = rxt(k,61) + mat(k,88) = 2.000_r8*rxt(k,63) + mat(k,37) = 2.000_r8*rxt(k,64) + mat(k,1234) = rxt(k,65) + mat(k,450) = rxt(k,67) + mat(k,90) = rxt(k,70) + mat(k,94) = rxt(k,71) + mat(k,104) = rxt(k,72) + mat(k,821) = rxt(k,73) + mat(k,403) = rxt(k,76) + mat(k,87) = -( rxt(k,63) + het_rates(k,39) ) + mat(k,36) = -( rxt(k,64) + rxt(k,172) + het_rates(k,40) ) + mat(k,1243) = -( rxt(k,65) + het_rates(k,41) ) + mat(k,455) = rxt(k,66) + mat(k,156) = rxt(k,77) + mat(k,38) = 2.000_r8*rxt(k,172) + mat(k,448) = -( rxt(k,66) + rxt(k,67) + rxt(k,347) + rxt(k,352) + rxt(k,358) & + + het_rates(k,42) ) + mat(k,4) = -( het_rates(k,43) ) + mat(k,510) = -( het_rates(k,44) ) + mat(k,780) = rxt(k,21) + rxt(k,22) + mat(k,549) = rxt(k,23) + mat(k,590) = rxt(k,25) + mat(k,478) = .380_r8*rxt(k,28) + mat(k,324) = rxt(k,30) + mat(k,460) = rxt(k,32) + mat(k,337) = 2.000_r8*rxt(k,33) + mat(k,559) = 1.340_r8*rxt(k,37) + mat(k,708) = .700_r8*rxt(k,39) + mat(k,468) = rxt(k,41) + mat(k,163) = rxt(k,80) + mat(k,323) = -( rxt(k,30) + het_rates(k,45) ) + mat(k,302) = rxt(k,26) + mat(k,476) = .440_r8*rxt(k,28) + mat(k,253) = .400_r8*rxt(k,42) + mat(k,136) = -( het_rates(k,46) ) + mat(k,5) = -( het_rates(k,47) ) + mat(k,6) = -( het_rates(k,48) ) + mat(k,7) = -( het_rates(k,49) ) + mat(k,8) = -( rxt(k,360) + het_rates(k,50) ) + mat(k,81) = -( rxt(k,31) + het_rates(k,51) ) + mat(k,459) = -( rxt(k,32) + het_rates(k,52) ) + mat(k,121) = rxt(k,246) + mat(k,336) = -( rxt(k,33) + het_rates(k,53) ) + mat(k,769) = -( rxt(k,100) + het_rates(k,54) ) + mat(k,1293) = rxt(k,2) + 2.000_r8*rxt(k,3) + mat(k,782) = 2.000_r8*rxt(k,21) + mat(k,202) = rxt(k,27) + mat(k,481) = .330_r8*rxt(k,28) + rxt(k,29) + mat(k,409) = rxt(k,69) + mat(k,818) = rxt(k,73) + mat(k,10) = rxt(k,74) + mat(k,514) = -( het_rates(k,55) ) + mat(k,1291) = rxt(k,1) + mat(k,781) = rxt(k,22) + mat(k,479) = 1.440_r8*rxt(k,28) + mat(k,42) = -( rxt(k,68) + het_rates(k,56) ) + mat(k,276) = -( rxt(k,4) + het_rates(k,57) ) + mat(k,84) = -( rxt(k,79) + het_rates(k,58) ) + mat(k,408) = -( rxt(k,69) + het_rates(k,59) ) + mat(k,89) = -( rxt(k,70) + het_rates(k,60) ) + mat(k,93) = -( rxt(k,71) + het_rates(k,61) ) + mat(k,103) = -( rxt(k,72) + het_rates(k,62) ) + mat(k,820) = -( rxt(k,73) + het_rates(k,63) ) + mat(k,9) = -( rxt(k,74) + het_rates(k,64) ) + mat(k,416) = -( rxt(k,9) + het_rates(k,65) ) + mat(k,125) = 2.000_r8*rxt(k,337) + 2.000_r8*rxt(k,343) + 2.000_r8*rxt(k,346) & + + 2.000_r8*rxt(k,357) + mat(k,1028) = .500_r8*rxt(k,339) + mat(k,1185) = rxt(k,340) + mat(k,466) = rxt(k,341) + mat(k,270) = rxt(k,345) + rxt(k,348) + rxt(k,353) + mat(k,447) = rxt(k,347) + rxt(k,352) + rxt(k,358) + mat(k,176) = -( rxt(k,10) + rxt(k,11) + rxt(k,135) + het_rates(k,66) ) + mat(k,352) = -( rxt(k,75) + het_rates(k,67) ) + mat(k,269) = rxt(k,345) + rxt(k,348) + rxt(k,353) + mat(k,401) = -( rxt(k,76) + het_rates(k,68) ) + mat(k,446) = rxt(k,347) + rxt(k,352) + rxt(k,358) + mat(k,503) = -( rxt(k,34) + het_rates(k,69) ) + mat(k,157) = -( het_rates(k,70) ) + mat(k,429) = -( het_rates(k,71) ) + mat(k,377) = -( het_rates(k,72) ) + mat(k,240) = -( rxt(k,35) + het_rates(k,73) ) + mat(k,560) = -( rxt(k,36) + rxt(k,37) + het_rates(k,74) ) + mat(k,241) = .288_r8*rxt(k,35) + mat(k,142) = -( het_rates(k,75) ) + mat(k,283) = -( rxt(k,38) + rxt(k,292) + het_rates(k,76) ) + mat(k,715) = -( rxt(k,39) + het_rates(k,77) ) + mat(k,244) = .402_r8*rxt(k,35) + mat(k,213) = -( rxt(k,117) + het_rates(k,78) ) + mat(k,1248) = rxt(k,15) + mat(k,97) = -( rxt(k,12) + het_rates(k,79) ) + mat(k,124) = -( rxt(k,13) + rxt(k,14) + rxt(k,136) + rxt(k,337) + rxt(k,343) & + + rxt(k,346) + rxt(k,357) + het_rates(k,80) ) + mat(k,11) = -( het_rates(k,81) ) + mat(k,12) = -( het_rates(k,82) ) + mat(k,13) = -( het_rates(k,83) ) + mat(k,45) = -( het_rates(k,84) ) + mat(k,14) = -( rxt(k,338) + het_rates(k,85) ) + mat(k,15) = -( rxt(k,362) + het_rates(k,86) ) + mat(k,16) = -( rxt(k,361) + het_rates(k,87) ) + mat(k,1286) = -( rxt(k,15) + het_rates(k,88) ) + mat(k,129) = rxt(k,14) + mat(k,1053) = rxt(k,16) + .500_r8*rxt(k,339) + mat(k,1219) = rxt(k,17) + mat(k,219) = rxt(k,117) + mat(k,1048) = -( rxt(k,16) + rxt(k,339) + het_rates(k,89) ) + mat(k,417) = rxt(k,9) + mat(k,178) = rxt(k,11) + rxt(k,135) + mat(k,127) = rxt(k,13) + rxt(k,136) + mat(k,1214) = rxt(k,18) + mat(k,289) = rxt(k,38) + rxt(k,292) + mat(k,198) = rxt(k,40) + mat(k,472) = rxt(k,41) + mat(k,257) = .600_r8*rxt(k,42) + rxt(k,252) + mat(k,274) = rxt(k,48) + mat(k,452) = rxt(k,66) + mat(k,1217) = -( rxt(k,17) + rxt(k,18) + rxt(k,340) + het_rates(k,90) ) + mat(k,180) = rxt(k,10) + mat(k,128) = rxt(k,13) + rxt(k,14) + rxt(k,136) + mat(k,259) = .400_r8*rxt(k,42) + mat(k,275) = rxt(k,49) + mat(k,454) = rxt(k,67) + mat(k,194) = -( rxt(k,40) + het_rates(k,91) ) + mat(k,17) = -( het_rates(k,92) ) + mat(k,18) = -( het_rates(k,93) ) + end do + end subroutine linmat01 + subroutine linmat02( avec_len, mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k + do k = 1,avec_len + mat(k,19) = -( het_rates(k,94) ) + mat(k,20) = -( het_rates(k,95) ) + mat(k,21) = -( het_rates(k,96) ) + mat(k,886) = -( rxt(k,94) + het_rates(k,97) ) + mat(k,1297) = rxt(k,3) + mat(k,1008) = rxt(k,8) + mat(k,126) = rxt(k,14) + mat(k,1277) = rxt(k,15) + mat(k,1044) = rxt(k,16) + mat(k,1210) = rxt(k,18) + mat(k,485) = .180_r8*rxt(k,28) + mat(k,325) = rxt(k,30) + mat(k,964) = rxt(k,47) + mat(k,1235) = rxt(k,65) + mat(k,155) = rxt(k,77) + mat(k,606) = rxt(k,81) + rxt(k,329) + mat(k,424) = rxt(k,82) + mat(k,118) = rxt(k,83) + mat(k,1081) = rxt(k,88) + rxt(k,89) + mat(k,215) = rxt(k,117) + mat(k,237) = rxt(k,322) + mat(k,1011) = -( rxt(k,7) + rxt(k,8) + het_rates(k,98) ) + mat(k,889) = rxt(k,94) + mat(k,22) = -( het_rates(k,99) ) + mat(k,152) = -( rxt(k,77) + het_rates(k,100) ) + mat(k,160) = -( rxt(k,80) + het_rates(k,101) ) + mat(k,467) = -( rxt(k,41) + rxt(k,341) + het_rates(k,102) ) + mat(k,252) = -( rxt(k,42) + rxt(k,252) + het_rates(k,103) ) + mat(k,23) = -( het_rates(k,104) ) + mat(k,24) = -( het_rates(k,105) ) + mat(k,260) = -( rxt(k,43) + het_rates(k,106) ) + mat(k,206) = -( rxt(k,44) + het_rates(k,107) ) + mat(k,234) = -( rxt(k,322) + het_rates(k,108) ) + mat(k,161) = rxt(k,80) + mat(k,600) = rxt(k,81) + mat(k,25) = -( rxt(k,78) + het_rates(k,109) ) + mat(k,602) = -( rxt(k,81) + rxt(k,329) + het_rates(k,110) ) + mat(k,423) = rxt(k,82) + mat(k,235) = rxt(k,322) + mat(k,422) = -( rxt(k,82) + het_rates(k,111) ) + mat(k,117) = rxt(k,83) + mat(k,601) = rxt(k,329) + mat(k,116) = -( rxt(k,83) + het_rates(k,112) ) + mat(k,85) = rxt(k,79) + mat(k,26) = -( het_rates(k,113) ) + mat(k,27) = -( het_rates(k,114) ) + mat(k,28) = -( het_rates(k,115) ) + mat(k,29) = -( het_rates(k,116) ) + mat(k,30) = -( rxt(k,84) + het_rates(k,117) ) + mat(k,31) = -( rxt(k,85) + het_rates(k,118) ) + mat(k,32) = -( rxt(k,342) + het_rates(k,119) ) + mat(k,34) = -( het_rates(k,120) ) + mat(k,33) = rxt(k,342) + mat(k,35) = -( rxt(k,363) + het_rates(k,121) ) + mat(k,308) = -( het_rates(k,122) ) + mat(k,100) = -( rxt(k,45) + het_rates(k,123) ) + mat(k,369) = -( het_rates(k,126) ) + mat(k,389) = -( het_rates(k,127) ) + mat(k,695) = -( het_rates(k,128) ) + mat(k,362) = rxt(k,24) + mat(k,592) = rxt(k,25) + mat(k,505) = rxt(k,34) + mat(k,564) = 1.340_r8*rxt(k,36) + mat(k,714) = .300_r8*rxt(k,39) + mat(k,196) = rxt(k,40) + mat(k,254) = .600_r8*rxt(k,42) + rxt(k,252) + mat(k,208) = rxt(k,44) + mat(k,753) = -( het_rates(k,129) ) + mat(k,552) = rxt(k,23) + mat(k,363) = rxt(k,24) + mat(k,304) = rxt(k,26) + mat(k,480) = rxt(k,29) + mat(k,716) = .300_r8*rxt(k,39) + mat(k,255) = .400_r8*rxt(k,42) + mat(k,293) = rxt(k,59) + mat(k,170) = rxt(k,61) + mat(k,120) = -( rxt(k,245) + rxt(k,246) + het_rates(k,130) ) + mat(k,82) = rxt(k,31) + mat(k,328) = -( het_rates(k,131) ) + mat(k,943) = -( rxt(k,336) + het_rates(k,132) ) + mat(k,177) = rxt(k,11) + rxt(k,135) + mat(k,150) = rxt(k,19) + mat(k,191) = rxt(k,20) + mat(k,554) = rxt(k,23) + mat(k,594) = rxt(k,25) + mat(k,463) = 2.000_r8*rxt(k,32) + mat(k,339) = 2.000_r8*rxt(k,33) + mat(k,507) = rxt(k,34) + mat(k,246) = rxt(k,35) + mat(k,567) = 1.340_r8*rxt(k,36) + .660_r8*rxt(k,37) + mat(k,471) = rxt(k,41) + mat(k,265) = rxt(k,43) + mat(k,773) = rxt(k,100) + mat(k,123) = rxt(k,245) + rxt(k,246) + mat(k,626) = -( het_rates(k,133) ) + mat(k,649) = -( het_rates(k,134) ) + mat(k,668) = -( het_rates(k,135) ) + mat(k,563) = .660_r8*rxt(k,36) + mat(k,286) = rxt(k,38) + rxt(k,292) + mat(k,1086) = -( rxt(k,88) + rxt(k,89) + het_rates(k,136) ) + mat(k,1302) = rxt(k,1) + mat(k,1013) = rxt(k,7) + mat(k,98) = rxt(k,12) + mat(k,1172) = -( het_rates(k,137) ) + mat(k,1303) = rxt(k,2) + mat(k,281) = 2.000_r8*rxt(k,4) + mat(k,418) = rxt(k,9) + mat(k,179) = rxt(k,10) + mat(k,151) = rxt(k,19) + mat(k,192) = rxt(k,20) + mat(k,306) = rxt(k,26) + mat(k,204) = rxt(k,27) + mat(k,488) = .330_r8*rxt(k,28) + mat(k,83) = rxt(k,31) + mat(k,266) = rxt(k,43) + mat(k,210) = rxt(k,44) + mat(k,102) = rxt(k,45) + mat(k,358) = rxt(k,75) + mat(k,405) = rxt(k,76) + mat(k,1050) = .500_r8*rxt(k,339) + mat(k,342) = -( het_rates(k,138) ) + mat(k,492) = -( het_rates(k,139) ) + mat(k,578) = -( het_rates(k,140) ) + mat(k,1307) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,141) ) + mat(k,489) = .050_r8*rxt(k,28) + mat(k,86) = rxt(k,79) + mat(k,952) = rxt(k,336) + end do + end subroutine linmat02 + subroutine linmat( avec_len, mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) + real(r8), intent(inout) :: mat(veclen,nzcnt) + call linmat01( avec_len, mat, y, rxt, het_rates ) + call linmat02( avec_len, mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_lu_factor.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_lu_factor.F90 new file mode 100644 index 0000000000..40790de3b2 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_lu_factor.F90 @@ -0,0 +1,4871 @@ + module mo_lu_factor + use chem_mods, only: veclen + private + public :: lu_fac + contains + subroutine lu_fac01( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1) = 1._r8 / lu(k,1) + lu(k,2) = 1._r8 / lu(k,2) + lu(k,3) = 1._r8 / lu(k,3) + lu(k,4) = 1._r8 / lu(k,4) + lu(k,5) = 1._r8 / lu(k,5) + lu(k,6) = 1._r8 / lu(k,6) + lu(k,7) = 1._r8 / lu(k,7) + lu(k,8) = 1._r8 / lu(k,8) + lu(k,9) = 1._r8 / lu(k,9) + lu(k,10) = lu(k,10) * lu(k,9) + lu(k,11) = 1._r8 / lu(k,11) + lu(k,12) = 1._r8 / lu(k,12) + lu(k,13) = 1._r8 / lu(k,13) + lu(k,14) = 1._r8 / lu(k,14) + lu(k,15) = 1._r8 / lu(k,15) + lu(k,16) = 1._r8 / lu(k,16) + lu(k,17) = 1._r8 / lu(k,17) + lu(k,18) = 1._r8 / lu(k,18) + lu(k,19) = 1._r8 / lu(k,19) + lu(k,20) = 1._r8 / lu(k,20) + lu(k,21) = 1._r8 / lu(k,21) + lu(k,22) = 1._r8 / lu(k,22) + lu(k,23) = 1._r8 / lu(k,23) + lu(k,24) = 1._r8 / lu(k,24) + lu(k,25) = 1._r8 / lu(k,25) + lu(k,26) = 1._r8 / lu(k,26) + lu(k,27) = 1._r8 / lu(k,27) + lu(k,28) = 1._r8 / lu(k,28) + lu(k,29) = 1._r8 / lu(k,29) + lu(k,30) = 1._r8 / lu(k,30) + lu(k,31) = 1._r8 / lu(k,31) + lu(k,32) = 1._r8 / lu(k,32) + lu(k,33) = lu(k,33) * lu(k,32) + lu(k,34) = 1._r8 / lu(k,34) + lu(k,35) = 1._r8 / lu(k,35) + lu(k,36) = 1._r8 / lu(k,36) + lu(k,37) = lu(k,37) * lu(k,36) + lu(k,38) = lu(k,38) * lu(k,36) + lu(k,1234) = lu(k,1234) - lu(k,37) * lu(k,1221) + lu(k,1243) = lu(k,1243) - lu(k,38) * lu(k,1221) + lu(k,39) = 1._r8 / lu(k,39) + lu(k,40) = lu(k,40) * lu(k,39) + lu(k,41) = lu(k,41) * lu(k,39) + lu(k,1135) = lu(k,1135) - lu(k,40) * lu(k,1092) + lu(k,1172) = lu(k,1172) - lu(k,41) * lu(k,1092) + lu(k,42) = 1._r8 / lu(k,42) + lu(k,43) = lu(k,43) * lu(k,42) + lu(k,44) = lu(k,44) * lu(k,42) + lu(k,1078) = lu(k,1078) - lu(k,43) * lu(k,1055) + lu(k,1086) = lu(k,1086) - lu(k,44) * lu(k,1055) + lu(k,45) = 1._r8 / lu(k,45) + lu(k,46) = lu(k,46) * lu(k,45) + lu(k,47) = lu(k,47) * lu(k,45) + lu(k,1172) = lu(k,1172) - lu(k,46) * lu(k,1093) + lu(k,1176) = lu(k,1176) - lu(k,47) * lu(k,1093) + lu(k,48) = 1._r8 / lu(k,48) + lu(k,49) = lu(k,49) * lu(k,48) + lu(k,50) = lu(k,50) * lu(k,48) + lu(k,1080) = lu(k,1080) - lu(k,49) * lu(k,1056) + lu(k,1086) = lu(k,1086) - lu(k,50) * lu(k,1056) + lu(k,51) = 1._r8 / lu(k,51) + lu(k,52) = lu(k,52) * lu(k,51) + lu(k,53) = lu(k,53) * lu(k,51) + lu(k,1078) = lu(k,1078) - lu(k,52) * lu(k,1057) + lu(k,1086) = lu(k,1086) - lu(k,53) * lu(k,1057) + end do + end subroutine lu_fac01 + subroutine lu_fac02( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,54) = 1._r8 / lu(k,54) + lu(k,55) = lu(k,55) * lu(k,54) + lu(k,56) = lu(k,56) * lu(k,54) + lu(k,1080) = lu(k,1080) - lu(k,55) * lu(k,1058) + lu(k,1086) = lu(k,1086) - lu(k,56) * lu(k,1058) + lu(k,57) = 1._r8 / lu(k,57) + lu(k,58) = lu(k,58) * lu(k,57) + lu(k,59) = lu(k,59) * lu(k,57) + lu(k,1080) = lu(k,1080) - lu(k,58) * lu(k,1059) + lu(k,1086) = lu(k,1086) - lu(k,59) * lu(k,1059) + lu(k,60) = 1._r8 / lu(k,60) + lu(k,61) = lu(k,61) * lu(k,60) + lu(k,62) = lu(k,62) * lu(k,60) + lu(k,1080) = lu(k,1080) - lu(k,61) * lu(k,1060) + lu(k,1086) = lu(k,1086) - lu(k,62) * lu(k,1060) + lu(k,63) = 1._r8 / lu(k,63) + lu(k,64) = lu(k,64) * lu(k,63) + lu(k,65) = lu(k,65) * lu(k,63) + lu(k,1080) = lu(k,1080) - lu(k,64) * lu(k,1061) + lu(k,1086) = lu(k,1086) - lu(k,65) * lu(k,1061) + lu(k,66) = 1._r8 / lu(k,66) + lu(k,67) = lu(k,67) * lu(k,66) + lu(k,68) = lu(k,68) * lu(k,66) + lu(k,1080) = lu(k,1080) - lu(k,67) * lu(k,1062) + lu(k,1086) = lu(k,1086) - lu(k,68) * lu(k,1062) + lu(k,69) = 1._r8 / lu(k,69) + lu(k,70) = lu(k,70) * lu(k,69) + lu(k,71) = lu(k,71) * lu(k,69) + lu(k,72) = lu(k,72) * lu(k,69) + lu(k,1135) = lu(k,1135) - lu(k,70) * lu(k,1094) + lu(k,1172) = lu(k,1172) - lu(k,71) * lu(k,1094) + lu(k,1176) = lu(k,1176) - lu(k,72) * lu(k,1094) + lu(k,73) = 1._r8 / lu(k,73) + lu(k,74) = lu(k,74) * lu(k,73) + lu(k,75) = lu(k,75) * lu(k,73) + lu(k,76) = lu(k,76) * lu(k,73) + lu(k,1078) = lu(k,1078) - lu(k,74) * lu(k,1063) + lu(k,1080) = lu(k,1080) - lu(k,75) * lu(k,1063) + lu(k,1086) = lu(k,1086) - lu(k,76) * lu(k,1063) + lu(k,77) = 1._r8 / lu(k,77) + lu(k,78) = lu(k,78) * lu(k,77) + lu(k,79) = lu(k,79) * lu(k,77) + lu(k,80) = lu(k,80) * lu(k,77) + lu(k,1165) = lu(k,1165) - lu(k,78) * lu(k,1095) + lu(k,1172) = lu(k,1172) - lu(k,79) * lu(k,1095) + lu(k,1176) = lu(k,1176) - lu(k,80) * lu(k,1095) + lu(k,81) = 1._r8 / lu(k,81) + lu(k,82) = lu(k,82) * lu(k,81) + lu(k,83) = lu(k,83) * lu(k,81) + lu(k,327) = lu(k,327) - lu(k,82) * lu(k,326) + lu(k,333) = - lu(k,83) * lu(k,326) + lu(k,899) = - lu(k,82) * lu(k,897) + lu(k,948) = lu(k,948) - lu(k,83) * lu(k,897) + lu(k,84) = 1._r8 / lu(k,84) + lu(k,85) = lu(k,85) * lu(k,84) + lu(k,86) = lu(k,86) * lu(k,84) + lu(k,116) = lu(k,116) - lu(k,85) * lu(k,115) + lu(k,119) = lu(k,119) - lu(k,86) * lu(k,115) + lu(k,1289) = lu(k,1289) - lu(k,85) * lu(k,1288) + lu(k,1307) = lu(k,1307) - lu(k,86) * lu(k,1288) + lu(k,87) = 1._r8 / lu(k,87) + lu(k,88) = lu(k,88) * lu(k,87) + lu(k,403) = lu(k,403) - lu(k,88) * lu(k,400) + lu(k,450) = lu(k,450) - lu(k,88) * lu(k,445) + lu(k,821) = lu(k,821) - lu(k,88) * lu(k,812) + lu(k,856) = lu(k,856) - lu(k,88) * lu(k,832) + lu(k,1234) = lu(k,1234) - lu(k,88) * lu(k,1222) + lu(k,89) = 1._r8 / lu(k,89) + lu(k,90) = lu(k,90) * lu(k,89) + lu(k,91) = lu(k,91) * lu(k,89) + lu(k,92) = lu(k,92) * lu(k,89) + lu(k,1080) = lu(k,1080) - lu(k,90) * lu(k,1064) + lu(k,1086) = lu(k,1086) - lu(k,91) * lu(k,1064) + lu(k,1087) = lu(k,1087) - lu(k,92) * lu(k,1064) + lu(k,1165) = lu(k,1165) - lu(k,90) * lu(k,1096) + lu(k,1171) = - lu(k,91) * lu(k,1096) + lu(k,1172) = lu(k,1172) - lu(k,92) * lu(k,1096) + lu(k,93) = 1._r8 / lu(k,93) + lu(k,94) = lu(k,94) * lu(k,93) + lu(k,95) = lu(k,95) * lu(k,93) + lu(k,96) = lu(k,96) * lu(k,93) + lu(k,1080) = lu(k,1080) - lu(k,94) * lu(k,1065) + lu(k,1086) = lu(k,1086) - lu(k,95) * lu(k,1065) + lu(k,1087) = lu(k,1087) - lu(k,96) * lu(k,1065) + lu(k,1165) = lu(k,1165) - lu(k,94) * lu(k,1097) + lu(k,1171) = lu(k,1171) - lu(k,95) * lu(k,1097) + lu(k,1172) = lu(k,1172) - lu(k,96) * lu(k,1097) + lu(k,97) = 1._r8 / lu(k,97) + lu(k,98) = lu(k,98) * lu(k,97) + lu(k,99) = lu(k,99) * lu(k,97) + lu(k,217) = - lu(k,98) * lu(k,212) + lu(k,219) = lu(k,219) - lu(k,99) * lu(k,212) + lu(k,1049) = - lu(k,98) * lu(k,1019) + lu(k,1053) = lu(k,1053) - lu(k,99) * lu(k,1019) + lu(k,1086) = lu(k,1086) - lu(k,98) * lu(k,1066) + lu(k,1090) = lu(k,1090) - lu(k,99) * lu(k,1066) + end do + end subroutine lu_fac02 + subroutine lu_fac03( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,100) = 1._r8 / lu(k,100) + lu(k,101) = lu(k,101) * lu(k,100) + lu(k,102) = lu(k,102) * lu(k,100) + lu(k,578) = lu(k,578) - lu(k,101) * lu(k,571) + lu(k,586) = - lu(k,102) * lu(k,571) + lu(k,929) = lu(k,929) - lu(k,101) * lu(k,898) + lu(k,948) = lu(k,948) - lu(k,102) * lu(k,898) + lu(k,1152) = lu(k,1152) - lu(k,101) * lu(k,1098) + lu(k,1172) = lu(k,1172) - lu(k,102) * lu(k,1098) + lu(k,103) = 1._r8 / lu(k,103) + lu(k,104) = lu(k,104) * lu(k,103) + lu(k,105) = lu(k,105) * lu(k,103) + lu(k,106) = lu(k,106) * lu(k,103) + lu(k,107) = lu(k,107) * lu(k,103) + lu(k,1080) = lu(k,1080) - lu(k,104) * lu(k,1067) + lu(k,1086) = lu(k,1086) - lu(k,105) * lu(k,1067) + lu(k,1087) = lu(k,1087) - lu(k,106) * lu(k,1067) + lu(k,1091) = lu(k,1091) - lu(k,107) * lu(k,1067) + lu(k,1165) = lu(k,1165) - lu(k,104) * lu(k,1099) + lu(k,1171) = lu(k,1171) - lu(k,105) * lu(k,1099) + lu(k,1172) = lu(k,1172) - lu(k,106) * lu(k,1099) + lu(k,1176) = lu(k,1176) - lu(k,107) * lu(k,1099) + lu(k,108) = 1._r8 / lu(k,108) + lu(k,109) = lu(k,109) * lu(k,108) + lu(k,110) = lu(k,110) * lu(k,108) + lu(k,353) = lu(k,353) - lu(k,109) * lu(k,351) + lu(k,355) = - lu(k,110) * lu(k,351) + lu(k,819) = - lu(k,109) * lu(k,813) + lu(k,821) = lu(k,821) - lu(k,110) * lu(k,813) + lu(k,961) = lu(k,961) - lu(k,109) * lu(k,953) + lu(k,963) = lu(k,963) - lu(k,110) * lu(k,953) + lu(k,1232) = lu(k,1232) - lu(k,109) * lu(k,1223) + lu(k,1234) = lu(k,1234) - lu(k,110) * lu(k,1223) + lu(k,111) = 1._r8 / lu(k,111) + lu(k,112) = lu(k,112) * lu(k,111) + lu(k,113) = lu(k,113) * lu(k,111) + lu(k,114) = lu(k,114) * lu(k,111) + lu(k,370) = lu(k,370) - lu(k,112) * lu(k,366) + lu(k,373) = lu(k,373) - lu(k,113) * lu(k,366) + lu(k,375) = - lu(k,114) * lu(k,366) + lu(k,744) = lu(k,744) - lu(k,112) * lu(k,730) + lu(k,759) = lu(k,759) - lu(k,113) * lu(k,730) + lu(k,763) = - lu(k,114) * lu(k,730) + lu(k,1150) = lu(k,1150) - lu(k,112) * lu(k,1100) + lu(k,1167) = lu(k,1167) - lu(k,113) * lu(k,1100) + lu(k,1172) = lu(k,1172) - lu(k,114) * lu(k,1100) + lu(k,116) = 1._r8 / lu(k,116) + lu(k,117) = lu(k,117) * lu(k,116) + lu(k,118) = lu(k,118) * lu(k,116) + lu(k,119) = lu(k,119) * lu(k,116) + lu(k,422) = lu(k,422) - lu(k,117) * lu(k,421) + lu(k,424) = lu(k,424) - lu(k,118) * lu(k,421) + lu(k,427) = - lu(k,119) * lu(k,421) + lu(k,1139) = lu(k,1139) - lu(k,117) * lu(k,1101) + lu(k,1166) = lu(k,1166) - lu(k,118) * lu(k,1101) + lu(k,1176) = lu(k,1176) - lu(k,119) * lu(k,1101) + lu(k,1290) = - lu(k,117) * lu(k,1289) + lu(k,1297) = lu(k,1297) - lu(k,118) * lu(k,1289) + lu(k,1307) = lu(k,1307) - lu(k,119) * lu(k,1289) + lu(k,120) = 1._r8 / lu(k,120) + lu(k,121) = lu(k,121) * lu(k,120) + lu(k,122) = lu(k,122) * lu(k,120) + lu(k,123) = lu(k,123) * lu(k,120) + lu(k,329) = - lu(k,121) * lu(k,327) + lu(k,330) = lu(k,330) - lu(k,122) * lu(k,327) + lu(k,331) = lu(k,331) - lu(k,123) * lu(k,327) + lu(k,921) = - lu(k,121) * lu(k,899) + lu(k,938) = lu(k,938) - lu(k,122) * lu(k,899) + lu(k,943) = lu(k,943) - lu(k,123) * lu(k,899) + lu(k,1257) = lu(k,1257) - lu(k,121) * lu(k,1246) + lu(k,1273) = lu(k,1273) - lu(k,122) * lu(k,1246) + lu(k,1278) = lu(k,1278) - lu(k,123) * lu(k,1246) + lu(k,124) = 1._r8 / lu(k,124) + lu(k,125) = lu(k,125) * lu(k,124) + lu(k,126) = lu(k,126) * lu(k,124) + lu(k,127) = lu(k,127) * lu(k,124) + lu(k,128) = lu(k,128) * lu(k,124) + lu(k,129) = lu(k,129) * lu(k,124) + lu(k,1028) = lu(k,1028) - lu(k,125) * lu(k,1020) + lu(k,1044) = lu(k,1044) - lu(k,126) * lu(k,1020) + lu(k,1048) = lu(k,1048) - lu(k,127) * lu(k,1020) + lu(k,1051) = lu(k,1051) - lu(k,128) * lu(k,1020) + lu(k,1053) = lu(k,1053) - lu(k,129) * lu(k,1020) + lu(k,1185) = lu(k,1185) - lu(k,125) * lu(k,1177) + lu(k,1210) = lu(k,1210) - lu(k,126) * lu(k,1177) + lu(k,1214) = lu(k,1214) - lu(k,127) * lu(k,1177) + lu(k,1217) = lu(k,1217) - lu(k,128) * lu(k,1177) + lu(k,1219) = lu(k,1219) - lu(k,129) * lu(k,1177) + lu(k,130) = 1._r8 / lu(k,130) + lu(k,131) = lu(k,131) * lu(k,130) + lu(k,132) = lu(k,132) * lu(k,130) + lu(k,133) = lu(k,133) * lu(k,130) + lu(k,134) = lu(k,134) * lu(k,130) + lu(k,135) = lu(k,135) * lu(k,130) + lu(k,841) = lu(k,841) - lu(k,131) * lu(k,833) + lu(k,855) = lu(k,855) - lu(k,132) * lu(k,833) + lu(k,856) = lu(k,856) - lu(k,133) * lu(k,833) + lu(k,863) = lu(k,863) - lu(k,134) * lu(k,833) + lu(k,867) = - lu(k,135) * lu(k,833) + lu(k,1134) = lu(k,1134) - lu(k,131) * lu(k,1102) + lu(k,1164) = lu(k,1164) - lu(k,132) * lu(k,1102) + lu(k,1165) = lu(k,1165) - lu(k,133) * lu(k,1102) + lu(k,1172) = lu(k,1172) - lu(k,134) * lu(k,1102) + lu(k,1176) = lu(k,1176) - lu(k,135) * lu(k,1102) + lu(k,136) = 1._r8 / lu(k,136) + lu(k,137) = lu(k,137) * lu(k,136) + lu(k,138) = lu(k,138) * lu(k,136) + lu(k,139) = lu(k,139) * lu(k,136) + lu(k,140) = lu(k,140) * lu(k,136) + lu(k,141) = lu(k,141) * lu(k,136) + lu(k,1138) = lu(k,1138) - lu(k,137) * lu(k,1103) + lu(k,1139) = lu(k,1139) - lu(k,138) * lu(k,1103) + lu(k,1167) = lu(k,1167) - lu(k,139) * lu(k,1103) + lu(k,1172) = lu(k,1172) - lu(k,140) * lu(k,1103) + lu(k,1173) = lu(k,1173) - lu(k,141) * lu(k,1103) + lu(k,1185) = lu(k,1185) - lu(k,137) * lu(k,1178) + lu(k,1186) = lu(k,1186) - lu(k,138) * lu(k,1178) + lu(k,1211) = lu(k,1211) - lu(k,139) * lu(k,1178) + lu(k,1216) = lu(k,1216) - lu(k,140) * lu(k,1178) + lu(k,1217) = lu(k,1217) - lu(k,141) * lu(k,1178) + end do + end subroutine lu_fac03 + subroutine lu_fac04( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,142) = 1._r8 / lu(k,142) + lu(k,143) = lu(k,143) * lu(k,142) + lu(k,144) = lu(k,144) * lu(k,142) + lu(k,145) = lu(k,145) * lu(k,142) + lu(k,146) = lu(k,146) * lu(k,142) + lu(k,649) = lu(k,649) - lu(k,143) * lu(k,641) + lu(k,650) = - lu(k,144) * lu(k,641) + lu(k,655) = lu(k,655) - lu(k,145) * lu(k,641) + lu(k,657) = - lu(k,146) * lu(k,641) + lu(k,932) = lu(k,932) - lu(k,143) * lu(k,900) + lu(k,933) = lu(k,933) - lu(k,144) * lu(k,900) + lu(k,943) = lu(k,943) - lu(k,145) * lu(k,900) + lu(k,948) = lu(k,948) - lu(k,146) * lu(k,900) + lu(k,1156) = lu(k,1156) - lu(k,143) * lu(k,1104) + lu(k,1157) = lu(k,1157) - lu(k,144) * lu(k,1104) + lu(k,1167) = lu(k,1167) - lu(k,145) * lu(k,1104) + lu(k,1172) = lu(k,1172) - lu(k,146) * lu(k,1104) + lu(k,147) = 1._r8 / lu(k,147) + lu(k,148) = lu(k,148) * lu(k,147) + lu(k,149) = lu(k,149) * lu(k,147) + lu(k,150) = lu(k,150) * lu(k,147) + lu(k,151) = lu(k,151) * lu(k,147) + lu(k,369) = lu(k,369) - lu(k,148) * lu(k,367) + lu(k,370) = lu(k,370) - lu(k,149) * lu(k,367) + lu(k,373) = lu(k,373) - lu(k,150) * lu(k,367) + lu(k,375) = lu(k,375) - lu(k,151) * lu(k,367) + lu(k,916) = lu(k,916) - lu(k,148) * lu(k,901) + lu(k,927) = - lu(k,149) * lu(k,901) + lu(k,943) = lu(k,943) - lu(k,150) * lu(k,901) + lu(k,948) = lu(k,948) - lu(k,151) * lu(k,901) + lu(k,1134) = lu(k,1134) - lu(k,148) * lu(k,1105) + lu(k,1150) = lu(k,1150) - lu(k,149) * lu(k,1105) + lu(k,1167) = lu(k,1167) - lu(k,150) * lu(k,1105) + lu(k,1172) = lu(k,1172) - lu(k,151) * lu(k,1105) + lu(k,152) = 1._r8 / lu(k,152) + lu(k,153) = lu(k,153) * lu(k,152) + lu(k,154) = lu(k,154) * lu(k,152) + lu(k,155) = lu(k,155) * lu(k,152) + lu(k,156) = lu(k,156) * lu(k,152) + lu(k,601) = lu(k,601) - lu(k,153) * lu(k,599) + lu(k,602) = lu(k,602) - lu(k,154) * lu(k,599) + lu(k,606) = lu(k,606) - lu(k,155) * lu(k,599) + lu(k,612) = lu(k,612) - lu(k,156) * lu(k,599) + lu(k,958) = lu(k,958) - lu(k,153) * lu(k,954) + lu(k,959) = lu(k,959) - lu(k,154) * lu(k,954) + lu(k,964) = lu(k,964) - lu(k,155) * lu(k,954) + lu(k,972) = lu(k,972) - lu(k,156) * lu(k,954) + lu(k,1226) = lu(k,1226) - lu(k,153) * lu(k,1224) + lu(k,1228) = lu(k,1228) - lu(k,154) * lu(k,1224) + lu(k,1235) = lu(k,1235) - lu(k,155) * lu(k,1224) + lu(k,1243) = lu(k,1243) - lu(k,156) * lu(k,1224) + lu(k,157) = 1._r8 / lu(k,157) + lu(k,158) = lu(k,158) * lu(k,157) + lu(k,159) = lu(k,159) * lu(k,157) + lu(k,469) = - lu(k,158) * lu(k,465) + lu(k,473) = lu(k,473) - lu(k,159) * lu(k,465) + lu(k,624) = - lu(k,158) * lu(k,615) + lu(k,637) = - lu(k,159) * lu(k,615) + lu(k,690) = lu(k,690) - lu(k,158) * lu(k,680) + lu(k,703) = lu(k,703) - lu(k,159) * lu(k,680) + lu(k,746) = lu(k,746) - lu(k,158) * lu(k,731) + lu(k,763) = lu(k,763) - lu(k,159) * lu(k,731) + lu(k,1152) = lu(k,1152) - lu(k,158) * lu(k,1106) + lu(k,1172) = lu(k,1172) - lu(k,159) * lu(k,1106) + lu(k,1196) = lu(k,1196) - lu(k,158) * lu(k,1179) + lu(k,1216) = lu(k,1216) - lu(k,159) * lu(k,1179) + lu(k,1264) = lu(k,1264) - lu(k,158) * lu(k,1247) + lu(k,1283) = lu(k,1283) - lu(k,159) * lu(k,1247) + lu(k,160) = 1._r8 / lu(k,160) + lu(k,161) = lu(k,161) * lu(k,160) + lu(k,162) = lu(k,162) * lu(k,160) + lu(k,163) = lu(k,163) * lu(k,160) + lu(k,164) = lu(k,164) * lu(k,160) + lu(k,165) = lu(k,165) * lu(k,160) + lu(k,166) = lu(k,166) * lu(k,160) + lu(k,167) = lu(k,167) * lu(k,160) + lu(k,869) = - lu(k,161) * lu(k,868) + lu(k,876) = - lu(k,162) * lu(k,868) + lu(k,878) = lu(k,878) - lu(k,163) * lu(k,868) + lu(k,880) = lu(k,880) - lu(k,164) * lu(k,868) + lu(k,881) = lu(k,881) - lu(k,165) * lu(k,868) + lu(k,886) = lu(k,886) - lu(k,166) * lu(k,868) + lu(k,892) = lu(k,892) - lu(k,167) * lu(k,868) + lu(k,1118) = lu(k,1118) - lu(k,161) * lu(k,1107) + lu(k,1139) = lu(k,1139) - lu(k,162) * lu(k,1107) + lu(k,1147) = lu(k,1147) - lu(k,163) * lu(k,1107) + lu(k,1154) = lu(k,1154) - lu(k,164) * lu(k,1107) + lu(k,1161) = lu(k,1161) - lu(k,165) * lu(k,1107) + lu(k,1166) = lu(k,1166) - lu(k,166) * lu(k,1107) + lu(k,1172) = lu(k,1172) - lu(k,167) * lu(k,1107) + lu(k,168) = 1._r8 / lu(k,168) + lu(k,169) = lu(k,169) * lu(k,168) + lu(k,170) = lu(k,170) * lu(k,168) + lu(k,171) = lu(k,171) * lu(k,168) + lu(k,172) = lu(k,172) * lu(k,168) + lu(k,173) = lu(k,173) * lu(k,168) + lu(k,174) = lu(k,174) * lu(k,168) + lu(k,175) = lu(k,175) * lu(k,168) + lu(k,846) = lu(k,846) - lu(k,169) * lu(k,834) + lu(k,851) = lu(k,851) - lu(k,170) * lu(k,834) + lu(k,855) = lu(k,855) - lu(k,171) * lu(k,834) + lu(k,856) = lu(k,856) - lu(k,172) * lu(k,834) + lu(k,858) = lu(k,858) - lu(k,173) * lu(k,834) + lu(k,863) = lu(k,863) - lu(k,174) * lu(k,834) + lu(k,867) = lu(k,867) - lu(k,175) * lu(k,834) + lu(k,1147) = lu(k,1147) - lu(k,169) * lu(k,1108) + lu(k,1160) = lu(k,1160) - lu(k,170) * lu(k,1108) + lu(k,1164) = lu(k,1164) - lu(k,171) * lu(k,1108) + lu(k,1165) = lu(k,1165) - lu(k,172) * lu(k,1108) + lu(k,1167) = lu(k,1167) - lu(k,173) * lu(k,1108) + lu(k,1172) = lu(k,1172) - lu(k,174) * lu(k,1108) + lu(k,1176) = lu(k,1176) - lu(k,175) * lu(k,1108) + lu(k,176) = 1._r8 / lu(k,176) + lu(k,177) = lu(k,177) * lu(k,176) + lu(k,178) = lu(k,178) * lu(k,176) + lu(k,179) = lu(k,179) * lu(k,176) + lu(k,180) = lu(k,180) * lu(k,176) + lu(k,181) = lu(k,181) * lu(k,176) + lu(k,943) = lu(k,943) - lu(k,177) * lu(k,902) + lu(k,946) = lu(k,946) - lu(k,178) * lu(k,902) + lu(k,948) = lu(k,948) - lu(k,179) * lu(k,902) + lu(k,949) = lu(k,949) - lu(k,180) * lu(k,902) + lu(k,952) = lu(k,952) - lu(k,181) * lu(k,902) + lu(k,1045) = lu(k,1045) - lu(k,177) * lu(k,1021) + lu(k,1048) = lu(k,1048) - lu(k,178) * lu(k,1021) + lu(k,1050) = lu(k,1050) - lu(k,179) * lu(k,1021) + lu(k,1051) = lu(k,1051) - lu(k,180) * lu(k,1021) + lu(k,1054) = - lu(k,181) * lu(k,1021) + lu(k,1167) = lu(k,1167) - lu(k,177) * lu(k,1109) + lu(k,1170) = lu(k,1170) - lu(k,178) * lu(k,1109) + lu(k,1172) = lu(k,1172) - lu(k,179) * lu(k,1109) + lu(k,1173) = lu(k,1173) - lu(k,180) * lu(k,1109) + lu(k,1176) = lu(k,1176) - lu(k,181) * lu(k,1109) + lu(k,182) = 1._r8 / lu(k,182) + lu(k,183) = lu(k,183) * lu(k,182) + lu(k,184) = lu(k,184) * lu(k,182) + lu(k,185) = lu(k,185) * lu(k,182) + lu(k,186) = lu(k,186) * lu(k,182) + lu(k,187) = lu(k,187) * lu(k,182) + lu(k,854) = lu(k,854) - lu(k,183) * lu(k,835) + lu(k,855) = lu(k,855) - lu(k,184) * lu(k,835) + lu(k,856) = lu(k,856) - lu(k,185) * lu(k,835) + lu(k,862) = - lu(k,186) * lu(k,835) + lu(k,863) = lu(k,863) - lu(k,187) * lu(k,835) + lu(k,1078) = lu(k,1078) - lu(k,183) * lu(k,1068) + lu(k,1079) = lu(k,1079) - lu(k,184) * lu(k,1068) + lu(k,1080) = lu(k,1080) - lu(k,185) * lu(k,1068) + lu(k,1086) = lu(k,1086) - lu(k,186) * lu(k,1068) + lu(k,1087) = lu(k,1087) - lu(k,187) * lu(k,1068) + lu(k,1163) = lu(k,1163) - lu(k,183) * lu(k,1110) + lu(k,1164) = lu(k,1164) - lu(k,184) * lu(k,1110) + lu(k,1165) = lu(k,1165) - lu(k,185) * lu(k,1110) + lu(k,1171) = lu(k,1171) - lu(k,186) * lu(k,1110) + lu(k,1172) = lu(k,1172) - lu(k,187) * lu(k,1110) + end do + end subroutine lu_fac04 + subroutine lu_fac05( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,188) = 1._r8 / lu(k,188) + lu(k,189) = lu(k,189) * lu(k,188) + lu(k,190) = lu(k,190) * lu(k,188) + lu(k,191) = lu(k,191) * lu(k,188) + lu(k,192) = lu(k,192) * lu(k,188) + lu(k,193) = lu(k,193) * lu(k,188) + lu(k,388) = lu(k,388) - lu(k,189) * lu(k,387) + lu(k,389) = lu(k,389) - lu(k,190) * lu(k,387) + lu(k,395) = lu(k,395) - lu(k,191) * lu(k,387) + lu(k,397) = - lu(k,192) * lu(k,387) + lu(k,399) = - lu(k,193) * lu(k,387) + lu(k,915) = - lu(k,189) * lu(k,903) + lu(k,918) = lu(k,918) - lu(k,190) * lu(k,903) + lu(k,943) = lu(k,943) - lu(k,191) * lu(k,903) + lu(k,948) = lu(k,948) - lu(k,192) * lu(k,903) + lu(k,952) = lu(k,952) - lu(k,193) * lu(k,903) + lu(k,1133) = lu(k,1133) - lu(k,189) * lu(k,1111) + lu(k,1135) = lu(k,1135) - lu(k,190) * lu(k,1111) + lu(k,1167) = lu(k,1167) - lu(k,191) * lu(k,1111) + lu(k,1172) = lu(k,1172) - lu(k,192) * lu(k,1111) + lu(k,1176) = lu(k,1176) - lu(k,193) * lu(k,1111) + lu(k,194) = 1._r8 / lu(k,194) + lu(k,195) = lu(k,195) * lu(k,194) + lu(k,196) = lu(k,196) * lu(k,194) + lu(k,197) = lu(k,197) * lu(k,194) + lu(k,198) = lu(k,198) * lu(k,194) + lu(k,199) = lu(k,199) * lu(k,194) + lu(k,532) = - lu(k,195) * lu(k,522) + lu(k,533) = - lu(k,196) * lu(k,522) + lu(k,536) = lu(k,536) - lu(k,197) * lu(k,522) + lu(k,542) = - lu(k,198) * lu(k,522) + lu(k,544) = lu(k,544) - lu(k,199) * lu(k,522) + lu(k,1153) = lu(k,1153) - lu(k,195) * lu(k,1112) + lu(k,1158) = lu(k,1158) - lu(k,196) * lu(k,1112) + lu(k,1162) = lu(k,1162) - lu(k,197) * lu(k,1112) + lu(k,1170) = lu(k,1170) - lu(k,198) * lu(k,1112) + lu(k,1172) = lu(k,1172) - lu(k,199) * lu(k,1112) + lu(k,1197) = lu(k,1197) - lu(k,195) * lu(k,1180) + lu(k,1202) = lu(k,1202) - lu(k,196) * lu(k,1180) + lu(k,1206) = lu(k,1206) - lu(k,197) * lu(k,1180) + lu(k,1214) = lu(k,1214) - lu(k,198) * lu(k,1180) + lu(k,1216) = lu(k,1216) - lu(k,199) * lu(k,1180) + lu(k,200) = 1._r8 / lu(k,200) + lu(k,201) = lu(k,201) * lu(k,200) + lu(k,202) = lu(k,202) * lu(k,200) + lu(k,203) = lu(k,203) * lu(k,200) + lu(k,204) = lu(k,204) * lu(k,200) + lu(k,205) = lu(k,205) * lu(k,200) + lu(k,753) = lu(k,753) - lu(k,201) * lu(k,732) + lu(k,754) = - lu(k,202) * lu(k,732) + lu(k,755) = lu(k,755) - lu(k,203) * lu(k,732) + lu(k,763) = lu(k,763) - lu(k,204) * lu(k,732) + lu(k,767) = - lu(k,205) * lu(k,732) + lu(k,936) = lu(k,936) - lu(k,201) * lu(k,904) + lu(k,937) = lu(k,937) - lu(k,202) * lu(k,904) + lu(k,938) = lu(k,938) - lu(k,203) * lu(k,904) + lu(k,948) = lu(k,948) - lu(k,204) * lu(k,904) + lu(k,952) = lu(k,952) - lu(k,205) * lu(k,904) + lu(k,1160) = lu(k,1160) - lu(k,201) * lu(k,1113) + lu(k,1161) = lu(k,1161) - lu(k,202) * lu(k,1113) + lu(k,1162) = lu(k,1162) - lu(k,203) * lu(k,1113) + lu(k,1172) = lu(k,1172) - lu(k,204) * lu(k,1113) + lu(k,1176) = lu(k,1176) - lu(k,205) * lu(k,1113) + lu(k,206) = 1._r8 / lu(k,206) + lu(k,207) = lu(k,207) * lu(k,206) + lu(k,208) = lu(k,208) * lu(k,206) + lu(k,209) = lu(k,209) * lu(k,206) + lu(k,210) = lu(k,210) * lu(k,206) + lu(k,211) = lu(k,211) * lu(k,206) + lu(k,492) = lu(k,492) - lu(k,207) * lu(k,490) + lu(k,495) = lu(k,495) - lu(k,208) * lu(k,490) + lu(k,497) = lu(k,497) - lu(k,209) * lu(k,490) + lu(k,500) = lu(k,500) - lu(k,210) * lu(k,490) + lu(k,502) = - lu(k,211) * lu(k,490) + lu(k,923) = lu(k,923) - lu(k,207) * lu(k,905) + lu(k,934) = lu(k,934) - lu(k,208) * lu(k,905) + lu(k,938) = lu(k,938) - lu(k,209) * lu(k,905) + lu(k,948) = lu(k,948) - lu(k,210) * lu(k,905) + lu(k,952) = lu(k,952) - lu(k,211) * lu(k,905) + lu(k,1145) = lu(k,1145) - lu(k,207) * lu(k,1114) + lu(k,1158) = lu(k,1158) - lu(k,208) * lu(k,1114) + lu(k,1162) = lu(k,1162) - lu(k,209) * lu(k,1114) + lu(k,1172) = lu(k,1172) - lu(k,210) * lu(k,1114) + lu(k,1176) = lu(k,1176) - lu(k,211) * lu(k,1114) + lu(k,213) = 1._r8 / lu(k,213) + lu(k,214) = lu(k,214) * lu(k,213) + lu(k,215) = lu(k,215) * lu(k,213) + lu(k,216) = lu(k,216) * lu(k,213) + lu(k,217) = lu(k,217) * lu(k,213) + lu(k,218) = lu(k,218) * lu(k,213) + lu(k,219) = lu(k,219) * lu(k,213) + lu(k,1039) = - lu(k,214) * lu(k,1022) + lu(k,1044) = lu(k,1044) - lu(k,215) * lu(k,1022) + lu(k,1048) = lu(k,1048) - lu(k,216) * lu(k,1022) + lu(k,1049) = lu(k,1049) - lu(k,217) * lu(k,1022) + lu(k,1050) = lu(k,1050) - lu(k,218) * lu(k,1022) + lu(k,1053) = lu(k,1053) - lu(k,219) * lu(k,1022) + lu(k,1161) = lu(k,1161) - lu(k,214) * lu(k,1115) + lu(k,1166) = lu(k,1166) - lu(k,215) * lu(k,1115) + lu(k,1170) = lu(k,1170) - lu(k,216) * lu(k,1115) + lu(k,1171) = lu(k,1171) - lu(k,217) * lu(k,1115) + lu(k,1172) = lu(k,1172) - lu(k,218) * lu(k,1115) + lu(k,1175) = lu(k,1175) - lu(k,219) * lu(k,1115) + lu(k,1272) = - lu(k,214) * lu(k,1248) + lu(k,1277) = lu(k,1277) - lu(k,215) * lu(k,1248) + lu(k,1281) = lu(k,1281) - lu(k,216) * lu(k,1248) + lu(k,1282) = - lu(k,217) * lu(k,1248) + lu(k,1283) = lu(k,1283) - lu(k,218) * lu(k,1248) + lu(k,1286) = lu(k,1286) - lu(k,219) * lu(k,1248) + lu(k,220) = 1._r8 / lu(k,220) + lu(k,221) = lu(k,221) * lu(k,220) + lu(k,222) = lu(k,222) * lu(k,220) + lu(k,223) = lu(k,223) * lu(k,220) + lu(k,224) = lu(k,224) * lu(k,220) + lu(k,225) = lu(k,225) * lu(k,220) + lu(k,226) = lu(k,226) * lu(k,220) + lu(k,840) = - lu(k,221) * lu(k,836) + lu(k,846) = lu(k,846) - lu(k,222) * lu(k,836) + lu(k,853) = lu(k,853) - lu(k,223) * lu(k,836) + lu(k,858) = lu(k,858) - lu(k,224) * lu(k,836) + lu(k,860) = lu(k,860) - lu(k,225) * lu(k,836) + lu(k,863) = lu(k,863) - lu(k,226) * lu(k,836) + lu(k,980) = - lu(k,221) * lu(k,975) + lu(k,989) = lu(k,989) - lu(k,222) * lu(k,975) + lu(k,1004) = lu(k,1004) - lu(k,223) * lu(k,975) + lu(k,1009) = lu(k,1009) - lu(k,224) * lu(k,975) + lu(k,1011) = lu(k,1011) - lu(k,225) * lu(k,975) + lu(k,1014) = lu(k,1014) - lu(k,226) * lu(k,975) + lu(k,1130) = lu(k,1130) - lu(k,221) * lu(k,1116) + lu(k,1147) = lu(k,1147) - lu(k,222) * lu(k,1116) + lu(k,1162) = lu(k,1162) - lu(k,223) * lu(k,1116) + lu(k,1167) = lu(k,1167) - lu(k,224) * lu(k,1116) + lu(k,1169) = lu(k,1169) - lu(k,225) * lu(k,1116) + lu(k,1172) = lu(k,1172) - lu(k,226) * lu(k,1116) + end do + end subroutine lu_fac05 + subroutine lu_fac06( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,227) = 1._r8 / lu(k,227) + lu(k,228) = lu(k,228) * lu(k,227) + lu(k,229) = lu(k,229) * lu(k,227) + lu(k,230) = lu(k,230) * lu(k,227) + lu(k,231) = lu(k,231) * lu(k,227) + lu(k,232) = lu(k,232) * lu(k,227) + lu(k,233) = lu(k,233) * lu(k,227) + lu(k,854) = lu(k,854) - lu(k,228) * lu(k,837) + lu(k,855) = lu(k,855) - lu(k,229) * lu(k,837) + lu(k,856) = lu(k,856) - lu(k,230) * lu(k,837) + lu(k,862) = lu(k,862) - lu(k,231) * lu(k,837) + lu(k,863) = lu(k,863) - lu(k,232) * lu(k,837) + lu(k,867) = lu(k,867) - lu(k,233) * lu(k,837) + lu(k,1078) = lu(k,1078) - lu(k,228) * lu(k,1069) + lu(k,1079) = lu(k,1079) - lu(k,229) * lu(k,1069) + lu(k,1080) = lu(k,1080) - lu(k,230) * lu(k,1069) + lu(k,1086) = lu(k,1086) - lu(k,231) * lu(k,1069) + lu(k,1087) = lu(k,1087) - lu(k,232) * lu(k,1069) + lu(k,1091) = lu(k,1091) - lu(k,233) * lu(k,1069) + lu(k,1163) = lu(k,1163) - lu(k,228) * lu(k,1117) + lu(k,1164) = lu(k,1164) - lu(k,229) * lu(k,1117) + lu(k,1165) = lu(k,1165) - lu(k,230) * lu(k,1117) + lu(k,1171) = lu(k,1171) - lu(k,231) * lu(k,1117) + lu(k,1172) = lu(k,1172) - lu(k,232) * lu(k,1117) + lu(k,1176) = lu(k,1176) - lu(k,233) * lu(k,1117) + lu(k,234) = 1._r8 / lu(k,234) + lu(k,235) = lu(k,235) * lu(k,234) + lu(k,236) = lu(k,236) * lu(k,234) + lu(k,237) = lu(k,237) * lu(k,234) + lu(k,238) = lu(k,238) * lu(k,234) + lu(k,239) = lu(k,239) * lu(k,234) + lu(k,602) = lu(k,602) - lu(k,235) * lu(k,600) + lu(k,603) = lu(k,603) - lu(k,236) * lu(k,600) + lu(k,606) = lu(k,606) - lu(k,237) * lu(k,600) + lu(k,609) = lu(k,609) - lu(k,238) * lu(k,600) + lu(k,611) = lu(k,611) - lu(k,239) * lu(k,600) + lu(k,880) = lu(k,880) - lu(k,235) * lu(k,869) + lu(k,881) = lu(k,881) - lu(k,236) * lu(k,869) + lu(k,886) = lu(k,886) - lu(k,237) * lu(k,869) + lu(k,889) = lu(k,889) - lu(k,238) * lu(k,869) + lu(k,892) = lu(k,892) - lu(k,239) * lu(k,869) + lu(k,996) = lu(k,996) - lu(k,235) * lu(k,976) + lu(k,1003) = lu(k,1003) - lu(k,236) * lu(k,976) + lu(k,1008) = lu(k,1008) - lu(k,237) * lu(k,976) + lu(k,1011) = lu(k,1011) - lu(k,238) * lu(k,976) + lu(k,1014) = lu(k,1014) - lu(k,239) * lu(k,976) + lu(k,1154) = lu(k,1154) - lu(k,235) * lu(k,1118) + lu(k,1161) = lu(k,1161) - lu(k,236) * lu(k,1118) + lu(k,1166) = lu(k,1166) - lu(k,237) * lu(k,1118) + lu(k,1169) = lu(k,1169) - lu(k,238) * lu(k,1118) + lu(k,1172) = lu(k,1172) - lu(k,239) * lu(k,1118) + lu(k,240) = 1._r8 / lu(k,240) + lu(k,241) = lu(k,241) * lu(k,240) + lu(k,242) = lu(k,242) * lu(k,240) + lu(k,243) = lu(k,243) * lu(k,240) + lu(k,244) = lu(k,244) * lu(k,240) + lu(k,245) = lu(k,245) * lu(k,240) + lu(k,246) = lu(k,246) * lu(k,240) + lu(k,247) = lu(k,247) * lu(k,240) + lu(k,623) = lu(k,623) - lu(k,241) * lu(k,616) + lu(k,624) = lu(k,624) - lu(k,242) * lu(k,616) + lu(k,626) = lu(k,626) - lu(k,243) * lu(k,616) + lu(k,630) = lu(k,630) - lu(k,244) * lu(k,616) + lu(k,632) = lu(k,632) - lu(k,245) * lu(k,616) + lu(k,634) = lu(k,634) - lu(k,246) * lu(k,616) + lu(k,637) = lu(k,637) - lu(k,247) * lu(k,616) + lu(k,928) = lu(k,928) - lu(k,241) * lu(k,906) + lu(k,929) = lu(k,929) - lu(k,242) * lu(k,906) + lu(k,931) = lu(k,931) - lu(k,243) * lu(k,906) + lu(k,935) = lu(k,935) - lu(k,244) * lu(k,906) + lu(k,938) = lu(k,938) - lu(k,245) * lu(k,906) + lu(k,943) = lu(k,943) - lu(k,246) * lu(k,906) + lu(k,948) = lu(k,948) - lu(k,247) * lu(k,906) + lu(k,1151) = lu(k,1151) - lu(k,241) * lu(k,1119) + lu(k,1152) = lu(k,1152) - lu(k,242) * lu(k,1119) + lu(k,1155) = lu(k,1155) - lu(k,243) * lu(k,1119) + lu(k,1159) = lu(k,1159) - lu(k,244) * lu(k,1119) + lu(k,1162) = lu(k,1162) - lu(k,245) * lu(k,1119) + lu(k,1167) = lu(k,1167) - lu(k,246) * lu(k,1119) + lu(k,1172) = lu(k,1172) - lu(k,247) * lu(k,1119) + lu(k,248) = 1._r8 / lu(k,248) + lu(k,249) = lu(k,249) * lu(k,248) + lu(k,250) = lu(k,250) * lu(k,248) + lu(k,251) = lu(k,251) * lu(k,248) + lu(k,372) = lu(k,372) - lu(k,249) * lu(k,368) + lu(k,373) = lu(k,373) - lu(k,250) * lu(k,368) + lu(k,375) = lu(k,375) - lu(k,251) * lu(k,368) + lu(k,497) = lu(k,497) - lu(k,249) * lu(k,491) + lu(k,498) = lu(k,498) - lu(k,250) * lu(k,491) + lu(k,500) = lu(k,500) - lu(k,251) * lu(k,491) + lu(k,582) = lu(k,582) - lu(k,249) * lu(k,572) + lu(k,584) = lu(k,584) - lu(k,250) * lu(k,572) + lu(k,586) = lu(k,586) - lu(k,251) * lu(k,572) + lu(k,632) = lu(k,632) - lu(k,249) * lu(k,617) + lu(k,634) = lu(k,634) - lu(k,250) * lu(k,617) + lu(k,637) = lu(k,637) - lu(k,251) * lu(k,617) + lu(k,653) = lu(k,653) - lu(k,249) * lu(k,642) + lu(k,655) = lu(k,655) - lu(k,250) * lu(k,642) + lu(k,657) = lu(k,657) - lu(k,251) * lu(k,642) + lu(k,755) = lu(k,755) - lu(k,249) * lu(k,733) + lu(k,759) = lu(k,759) - lu(k,250) * lu(k,733) + lu(k,763) = lu(k,763) - lu(k,251) * lu(k,733) + lu(k,1162) = lu(k,1162) - lu(k,249) * lu(k,1120) + lu(k,1167) = lu(k,1167) - lu(k,250) * lu(k,1120) + lu(k,1172) = lu(k,1172) - lu(k,251) * lu(k,1120) + lu(k,252) = 1._r8 / lu(k,252) + lu(k,253) = lu(k,253) * lu(k,252) + lu(k,254) = lu(k,254) * lu(k,252) + lu(k,255) = lu(k,255) * lu(k,252) + lu(k,256) = lu(k,256) * lu(k,252) + lu(k,257) = lu(k,257) * lu(k,252) + lu(k,258) = lu(k,258) * lu(k,252) + lu(k,259) = lu(k,259) * lu(k,252) + lu(k,684) = lu(k,684) - lu(k,253) * lu(k,681) + lu(k,695) = lu(k,695) - lu(k,254) * lu(k,681) + lu(k,697) = lu(k,697) - lu(k,255) * lu(k,681) + lu(k,698) = lu(k,698) - lu(k,256) * lu(k,681) + lu(k,702) = lu(k,702) - lu(k,257) * lu(k,681) + lu(k,703) = lu(k,703) - lu(k,258) * lu(k,681) + lu(k,704) = - lu(k,259) * lu(k,681) + lu(k,1026) = - lu(k,253) * lu(k,1023) + lu(k,1036) = lu(k,1036) - lu(k,254) * lu(k,1023) + lu(k,1038) = - lu(k,255) * lu(k,1023) + lu(k,1040) = - lu(k,256) * lu(k,1023) + lu(k,1048) = lu(k,1048) - lu(k,257) * lu(k,1023) + lu(k,1050) = lu(k,1050) - lu(k,258) * lu(k,1023) + lu(k,1051) = lu(k,1051) - lu(k,259) * lu(k,1023) + lu(k,1129) = lu(k,1129) - lu(k,253) * lu(k,1121) + lu(k,1158) = lu(k,1158) - lu(k,254) * lu(k,1121) + lu(k,1160) = lu(k,1160) - lu(k,255) * lu(k,1121) + lu(k,1162) = lu(k,1162) - lu(k,256) * lu(k,1121) + lu(k,1170) = lu(k,1170) - lu(k,257) * lu(k,1121) + lu(k,1172) = lu(k,1172) - lu(k,258) * lu(k,1121) + lu(k,1173) = lu(k,1173) - lu(k,259) * lu(k,1121) + lu(k,260) = 1._r8 / lu(k,260) + lu(k,261) = lu(k,261) * lu(k,260) + lu(k,262) = lu(k,262) * lu(k,260) + lu(k,263) = lu(k,263) * lu(k,260) + lu(k,264) = lu(k,264) * lu(k,260) + lu(k,265) = lu(k,265) * lu(k,260) + lu(k,266) = lu(k,266) * lu(k,260) + lu(k,267) = lu(k,267) * lu(k,260) + lu(k,342) = lu(k,342) - lu(k,261) * lu(k,341) + lu(k,343) = - lu(k,262) * lu(k,341) + lu(k,344) = lu(k,344) - lu(k,263) * lu(k,341) + lu(k,345) = lu(k,345) - lu(k,264) * lu(k,341) + lu(k,346) = lu(k,346) - lu(k,265) * lu(k,341) + lu(k,348) = - lu(k,266) * lu(k,341) + lu(k,350) = - lu(k,267) * lu(k,341) + lu(k,913) = lu(k,913) - lu(k,261) * lu(k,907) + lu(k,924) = - lu(k,262) * lu(k,907) + lu(k,927) = lu(k,927) - lu(k,263) * lu(k,907) + lu(k,938) = lu(k,938) - lu(k,264) * lu(k,907) + lu(k,943) = lu(k,943) - lu(k,265) * lu(k,907) + lu(k,948) = lu(k,948) - lu(k,266) * lu(k,907) + lu(k,952) = lu(k,952) - lu(k,267) * lu(k,907) + lu(k,1132) = lu(k,1132) - lu(k,261) * lu(k,1122) + lu(k,1146) = lu(k,1146) - lu(k,262) * lu(k,1122) + lu(k,1150) = lu(k,1150) - lu(k,263) * lu(k,1122) + lu(k,1162) = lu(k,1162) - lu(k,264) * lu(k,1122) + lu(k,1167) = lu(k,1167) - lu(k,265) * lu(k,1122) + lu(k,1172) = lu(k,1172) - lu(k,266) * lu(k,1122) + lu(k,1176) = lu(k,1176) - lu(k,267) * lu(k,1122) + lu(k,268) = 1._r8 / lu(k,268) + lu(k,269) = lu(k,269) * lu(k,268) + lu(k,270) = lu(k,270) * lu(k,268) + lu(k,271) = lu(k,271) * lu(k,268) + lu(k,272) = lu(k,272) * lu(k,268) + lu(k,273) = lu(k,273) * lu(k,268) + lu(k,274) = lu(k,274) * lu(k,268) + lu(k,275) = lu(k,275) * lu(k,268) + lu(k,872) = lu(k,872) - lu(k,269) * lu(k,870) + lu(k,875) = - lu(k,270) * lu(k,870) + lu(k,883) = lu(k,883) - lu(k,271) * lu(k,870) + lu(k,886) = lu(k,886) - lu(k,272) * lu(k,870) + lu(k,888) = lu(k,888) - lu(k,273) * lu(k,870) + lu(k,890) = lu(k,890) - lu(k,274) * lu(k,870) + lu(k,893) = lu(k,893) - lu(k,275) * lu(k,870) + lu(k,956) = lu(k,956) - lu(k,269) * lu(k,955) + lu(k,957) = - lu(k,270) * lu(k,955) + lu(k,961) = lu(k,961) - lu(k,271) * lu(k,955) + lu(k,964) = lu(k,964) - lu(k,272) * lu(k,955) + lu(k,966) = lu(k,966) - lu(k,273) * lu(k,955) + lu(k,968) = lu(k,968) - lu(k,274) * lu(k,955) + lu(k,971) = - lu(k,275) * lu(k,955) + lu(k,1027) = - lu(k,269) * lu(k,1024) + lu(k,1028) = lu(k,1028) - lu(k,270) * lu(k,1024) + lu(k,1041) = - lu(k,271) * lu(k,1024) + lu(k,1044) = lu(k,1044) - lu(k,272) * lu(k,1024) + lu(k,1046) = lu(k,1046) - lu(k,273) * lu(k,1024) + lu(k,1048) = lu(k,1048) - lu(k,274) * lu(k,1024) + lu(k,1051) = lu(k,1051) - lu(k,275) * lu(k,1024) + end do + end subroutine lu_fac06 + subroutine lu_fac07( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,276) = 1._r8 / lu(k,276) + lu(k,277) = lu(k,277) * lu(k,276) + lu(k,278) = lu(k,278) * lu(k,276) + lu(k,279) = lu(k,279) * lu(k,276) + lu(k,280) = lu(k,280) * lu(k,276) + lu(k,281) = lu(k,281) * lu(k,276) + lu(k,282) = lu(k,282) * lu(k,276) + lu(k,855) = lu(k,855) - lu(k,277) * lu(k,838) + lu(k,856) = lu(k,856) - lu(k,278) * lu(k,838) + lu(k,857) = - lu(k,279) * lu(k,838) + lu(k,858) = lu(k,858) - lu(k,280) * lu(k,838) + lu(k,863) = lu(k,863) - lu(k,281) * lu(k,838) + lu(k,867) = lu(k,867) - lu(k,282) * lu(k,838) + lu(k,884) = lu(k,884) - lu(k,277) * lu(k,871) + lu(k,885) = lu(k,885) - lu(k,278) * lu(k,871) + lu(k,886) = lu(k,886) - lu(k,279) * lu(k,871) + lu(k,887) = lu(k,887) - lu(k,280) * lu(k,871) + lu(k,892) = lu(k,892) - lu(k,281) * lu(k,871) + lu(k,896) = - lu(k,282) * lu(k,871) + lu(k,940) = lu(k,940) - lu(k,277) * lu(k,908) + lu(k,941) = lu(k,941) - lu(k,278) * lu(k,908) + lu(k,942) = lu(k,942) - lu(k,279) * lu(k,908) + lu(k,943) = lu(k,943) - lu(k,280) * lu(k,908) + lu(k,948) = lu(k,948) - lu(k,281) * lu(k,908) + lu(k,952) = lu(k,952) - lu(k,282) * lu(k,908) + lu(k,1164) = lu(k,1164) - lu(k,277) * lu(k,1123) + lu(k,1165) = lu(k,1165) - lu(k,278) * lu(k,1123) + lu(k,1166) = lu(k,1166) - lu(k,279) * lu(k,1123) + lu(k,1167) = lu(k,1167) - lu(k,280) * lu(k,1123) + lu(k,1172) = lu(k,1172) - lu(k,281) * lu(k,1123) + lu(k,1176) = lu(k,1176) - lu(k,282) * lu(k,1123) + lu(k,283) = 1._r8 / lu(k,283) + lu(k,284) = lu(k,284) * lu(k,283) + lu(k,285) = lu(k,285) * lu(k,283) + lu(k,286) = lu(k,286) * lu(k,283) + lu(k,287) = lu(k,287) * lu(k,283) + lu(k,288) = lu(k,288) * lu(k,283) + lu(k,289) = lu(k,289) * lu(k,283) + lu(k,290) = lu(k,290) * lu(k,283) + lu(k,291) = lu(k,291) * lu(k,283) + lu(k,664) = lu(k,664) - lu(k,284) * lu(k,661) + lu(k,665) = - lu(k,285) * lu(k,661) + lu(k,668) = lu(k,668) - lu(k,286) * lu(k,661) + lu(k,671) = lu(k,671) - lu(k,287) * lu(k,661) + lu(k,673) = lu(k,673) - lu(k,288) * lu(k,661) + lu(k,675) = lu(k,675) - lu(k,289) * lu(k,661) + lu(k,676) = lu(k,676) - lu(k,290) * lu(k,661) + lu(k,677) = lu(k,677) - lu(k,291) * lu(k,661) + lu(k,1026) = lu(k,1026) - lu(k,284) * lu(k,1025) + lu(k,1031) = - lu(k,285) * lu(k,1025) + lu(k,1035) = lu(k,1035) - lu(k,286) * lu(k,1025) + lu(k,1040) = lu(k,1040) - lu(k,287) * lu(k,1025) + lu(k,1045) = lu(k,1045) - lu(k,288) * lu(k,1025) + lu(k,1048) = lu(k,1048) - lu(k,289) * lu(k,1025) + lu(k,1050) = lu(k,1050) - lu(k,290) * lu(k,1025) + lu(k,1051) = lu(k,1051) - lu(k,291) * lu(k,1025) + lu(k,1129) = lu(k,1129) - lu(k,284) * lu(k,1124) + lu(k,1146) = lu(k,1146) - lu(k,285) * lu(k,1124) + lu(k,1157) = lu(k,1157) - lu(k,286) * lu(k,1124) + lu(k,1162) = lu(k,1162) - lu(k,287) * lu(k,1124) + lu(k,1167) = lu(k,1167) - lu(k,288) * lu(k,1124) + lu(k,1170) = lu(k,1170) - lu(k,289) * lu(k,1124) + lu(k,1172) = lu(k,1172) - lu(k,290) * lu(k,1124) + lu(k,1173) = lu(k,1173) - lu(k,291) * lu(k,1124) + lu(k,292) = 1._r8 / lu(k,292) + lu(k,293) = lu(k,293) * lu(k,292) + lu(k,294) = lu(k,294) * lu(k,292) + lu(k,295) = lu(k,295) * lu(k,292) + lu(k,296) = lu(k,296) * lu(k,292) + lu(k,297) = lu(k,297) * lu(k,292) + lu(k,298) = lu(k,298) * lu(k,292) + lu(k,299) = lu(k,299) * lu(k,292) + lu(k,300) = lu(k,300) * lu(k,292) + lu(k,851) = lu(k,851) - lu(k,293) * lu(k,839) + lu(k,854) = lu(k,854) - lu(k,294) * lu(k,839) + lu(k,855) = lu(k,855) - lu(k,295) * lu(k,839) + lu(k,856) = lu(k,856) - lu(k,296) * lu(k,839) + lu(k,858) = lu(k,858) - lu(k,297) * lu(k,839) + lu(k,862) = lu(k,862) - lu(k,298) * lu(k,839) + lu(k,863) = lu(k,863) - lu(k,299) * lu(k,839) + lu(k,867) = lu(k,867) - lu(k,300) * lu(k,839) + lu(k,1075) = lu(k,1075) - lu(k,293) * lu(k,1070) + lu(k,1078) = lu(k,1078) - lu(k,294) * lu(k,1070) + lu(k,1079) = lu(k,1079) - lu(k,295) * lu(k,1070) + lu(k,1080) = lu(k,1080) - lu(k,296) * lu(k,1070) + lu(k,1082) = lu(k,1082) - lu(k,297) * lu(k,1070) + lu(k,1086) = lu(k,1086) - lu(k,298) * lu(k,1070) + lu(k,1087) = lu(k,1087) - lu(k,299) * lu(k,1070) + lu(k,1091) = lu(k,1091) - lu(k,300) * lu(k,1070) + lu(k,1160) = lu(k,1160) - lu(k,293) * lu(k,1125) + lu(k,1163) = lu(k,1163) - lu(k,294) * lu(k,1125) + lu(k,1164) = lu(k,1164) - lu(k,295) * lu(k,1125) + lu(k,1165) = lu(k,1165) - lu(k,296) * lu(k,1125) + lu(k,1167) = lu(k,1167) - lu(k,297) * lu(k,1125) + lu(k,1171) = lu(k,1171) - lu(k,298) * lu(k,1125) + lu(k,1172) = lu(k,1172) - lu(k,299) * lu(k,1125) + lu(k,1176) = lu(k,1176) - lu(k,300) * lu(k,1125) + lu(k,301) = 1._r8 / lu(k,301) + lu(k,302) = lu(k,302) * lu(k,301) + lu(k,303) = lu(k,303) * lu(k,301) + lu(k,304) = lu(k,304) * lu(k,301) + lu(k,305) = lu(k,305) * lu(k,301) + lu(k,306) = lu(k,306) * lu(k,301) + lu(k,307) = lu(k,307) * lu(k,301) + lu(k,664) = lu(k,664) - lu(k,302) * lu(k,662) + lu(k,669) = lu(k,669) - lu(k,303) * lu(k,662) + lu(k,670) = lu(k,670) - lu(k,304) * lu(k,662) + lu(k,671) = lu(k,671) - lu(k,305) * lu(k,662) + lu(k,676) = lu(k,676) - lu(k,306) * lu(k,662) + lu(k,679) = - lu(k,307) * lu(k,662) + lu(k,684) = lu(k,684) - lu(k,302) * lu(k,682) + lu(k,695) = lu(k,695) - lu(k,303) * lu(k,682) + lu(k,697) = lu(k,697) - lu(k,304) * lu(k,682) + lu(k,698) = lu(k,698) - lu(k,305) * lu(k,682) + lu(k,703) = lu(k,703) - lu(k,306) * lu(k,682) + lu(k,706) = - lu(k,307) * lu(k,682) + lu(k,911) = lu(k,911) - lu(k,302) * lu(k,909) + lu(k,934) = lu(k,934) - lu(k,303) * lu(k,909) + lu(k,936) = lu(k,936) - lu(k,304) * lu(k,909) + lu(k,938) = lu(k,938) - lu(k,305) * lu(k,909) + lu(k,948) = lu(k,948) - lu(k,306) * lu(k,909) + lu(k,952) = lu(k,952) - lu(k,307) * lu(k,909) + lu(k,1129) = lu(k,1129) - lu(k,302) * lu(k,1126) + lu(k,1158) = lu(k,1158) - lu(k,303) * lu(k,1126) + lu(k,1160) = lu(k,1160) - lu(k,304) * lu(k,1126) + lu(k,1162) = lu(k,1162) - lu(k,305) * lu(k,1126) + lu(k,1172) = lu(k,1172) - lu(k,306) * lu(k,1126) + lu(k,1176) = lu(k,1176) - lu(k,307) * lu(k,1126) + lu(k,308) = 1._r8 / lu(k,308) + lu(k,309) = lu(k,309) * lu(k,308) + lu(k,310) = lu(k,310) * lu(k,308) + lu(k,311) = lu(k,311) * lu(k,308) + lu(k,312) = lu(k,312) * lu(k,308) + lu(k,313) = lu(k,313) * lu(k,308) + lu(k,314) = lu(k,314) * lu(k,308) + lu(k,315) = lu(k,315) * lu(k,308) + lu(k,316) = lu(k,316) * lu(k,308) + lu(k,317) = lu(k,317) * lu(k,308) + lu(k,981) = - lu(k,309) * lu(k,977) + lu(k,993) = lu(k,993) - lu(k,310) * lu(k,977) + lu(k,997) = - lu(k,311) * lu(k,977) + lu(k,1001) = lu(k,1001) - lu(k,312) * lu(k,977) + lu(k,1008) = lu(k,1008) - lu(k,313) * lu(k,977) + lu(k,1011) = lu(k,1011) - lu(k,314) * lu(k,977) + lu(k,1012) = lu(k,1012) - lu(k,315) * lu(k,977) + lu(k,1014) = lu(k,1014) - lu(k,316) * lu(k,977) + lu(k,1015) = lu(k,1015) - lu(k,317) * lu(k,977) + lu(k,1133) = lu(k,1133) - lu(k,309) * lu(k,1127) + lu(k,1151) = lu(k,1151) - lu(k,310) * lu(k,1127) + lu(k,1155) = lu(k,1155) - lu(k,311) * lu(k,1127) + lu(k,1159) = lu(k,1159) - lu(k,312) * lu(k,1127) + lu(k,1166) = lu(k,1166) - lu(k,313) * lu(k,1127) + lu(k,1169) = lu(k,1169) - lu(k,314) * lu(k,1127) + lu(k,1170) = lu(k,1170) - lu(k,315) * lu(k,1127) + lu(k,1172) = lu(k,1172) - lu(k,316) * lu(k,1127) + lu(k,1173) = lu(k,1173) - lu(k,317) * lu(k,1127) + lu(k,1183) = - lu(k,309) * lu(k,1181) + lu(k,1195) = lu(k,1195) - lu(k,310) * lu(k,1181) + lu(k,1199) = lu(k,1199) - lu(k,311) * lu(k,1181) + lu(k,1203) = lu(k,1203) - lu(k,312) * lu(k,1181) + lu(k,1210) = lu(k,1210) - lu(k,313) * lu(k,1181) + lu(k,1213) = - lu(k,314) * lu(k,1181) + lu(k,1214) = lu(k,1214) - lu(k,315) * lu(k,1181) + lu(k,1216) = lu(k,1216) - lu(k,316) * lu(k,1181) + lu(k,1217) = lu(k,1217) - lu(k,317) * lu(k,1181) + end do + end subroutine lu_fac07 + subroutine lu_fac08( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,318) = 1._r8 / lu(k,318) + lu(k,319) = lu(k,319) * lu(k,318) + lu(k,320) = lu(k,320) * lu(k,318) + lu(k,321) = lu(k,321) * lu(k,318) + lu(k,322) = lu(k,322) * lu(k,318) + lu(k,524) = lu(k,524) - lu(k,319) * lu(k,523) + lu(k,534) = lu(k,534) - lu(k,320) * lu(k,523) + lu(k,544) = lu(k,544) - lu(k,321) * lu(k,523) + lu(k,547) = - lu(k,322) * lu(k,523) + lu(k,664) = lu(k,664) - lu(k,319) * lu(k,663) + lu(k,670) = lu(k,670) - lu(k,320) * lu(k,663) + lu(k,676) = lu(k,676) - lu(k,321) * lu(k,663) + lu(k,679) = lu(k,679) - lu(k,322) * lu(k,663) + lu(k,684) = lu(k,684) - lu(k,319) * lu(k,683) + lu(k,697) = lu(k,697) - lu(k,320) * lu(k,683) + lu(k,703) = lu(k,703) - lu(k,321) * lu(k,683) + lu(k,706) = lu(k,706) - lu(k,322) * lu(k,683) + lu(k,735) = lu(k,735) - lu(k,319) * lu(k,734) + lu(k,753) = lu(k,753) - lu(k,320) * lu(k,734) + lu(k,763) = lu(k,763) - lu(k,321) * lu(k,734) + lu(k,767) = lu(k,767) - lu(k,322) * lu(k,734) + lu(k,911) = lu(k,911) - lu(k,319) * lu(k,910) + lu(k,936) = lu(k,936) - lu(k,320) * lu(k,910) + lu(k,948) = lu(k,948) - lu(k,321) * lu(k,910) + lu(k,952) = lu(k,952) - lu(k,322) * lu(k,910) + lu(k,979) = lu(k,979) - lu(k,319) * lu(k,978) + lu(k,1002) = lu(k,1002) - lu(k,320) * lu(k,978) + lu(k,1014) = lu(k,1014) - lu(k,321) * lu(k,978) + lu(k,1018) = - lu(k,322) * lu(k,978) + lu(k,1129) = lu(k,1129) - lu(k,319) * lu(k,1128) + lu(k,1160) = lu(k,1160) - lu(k,320) * lu(k,1128) + lu(k,1172) = lu(k,1172) - lu(k,321) * lu(k,1128) + lu(k,1176) = lu(k,1176) - lu(k,322) * lu(k,1128) + lu(k,323) = 1._r8 / lu(k,323) + lu(k,324) = lu(k,324) * lu(k,323) + lu(k,325) = lu(k,325) * lu(k,323) + lu(k,337) = lu(k,337) - lu(k,324) * lu(k,335) + lu(k,338) = - lu(k,325) * lu(k,335) + lu(k,460) = lu(k,460) - lu(k,324) * lu(k,457) + lu(k,462) = - lu(k,325) * lu(k,457) + lu(k,478) = lu(k,478) - lu(k,324) * lu(k,476) + lu(k,485) = lu(k,485) - lu(k,325) * lu(k,476) + lu(k,510) = lu(k,510) - lu(k,324) * lu(k,509) + lu(k,511) = - lu(k,325) * lu(k,509) + lu(k,528) = lu(k,528) - lu(k,324) * lu(k,524) + lu(k,539) = - lu(k,325) * lu(k,524) + lu(k,577) = lu(k,577) - lu(k,324) * lu(k,573) + lu(k,583) = - lu(k,325) * lu(k,573) + lu(k,666) = - lu(k,324) * lu(k,664) + lu(k,672) = - lu(k,325) * lu(k,664) + lu(k,688) = lu(k,688) - lu(k,324) * lu(k,684) + lu(k,699) = - lu(k,325) * lu(k,684) + lu(k,708) = lu(k,708) - lu(k,324) * lu(k,707) + lu(k,721) = - lu(k,325) * lu(k,707) + lu(k,743) = lu(k,743) - lu(k,324) * lu(k,735) + lu(k,758) = - lu(k,325) * lu(k,735) + lu(k,925) = - lu(k,324) * lu(k,911) + lu(k,942) = lu(k,942) - lu(k,325) * lu(k,911) + lu(k,989) = lu(k,989) - lu(k,324) * lu(k,979) + lu(k,1008) = lu(k,1008) - lu(k,325) * lu(k,979) + lu(k,1032) = - lu(k,324) * lu(k,1026) + lu(k,1044) = lu(k,1044) - lu(k,325) * lu(k,1026) + lu(k,1147) = lu(k,1147) - lu(k,324) * lu(k,1129) + lu(k,1166) = lu(k,1166) - lu(k,325) * lu(k,1129) + lu(k,1261) = lu(k,1261) - lu(k,324) * lu(k,1249) + lu(k,1277) = lu(k,1277) - lu(k,325) * lu(k,1249) + lu(k,328) = 1._r8 / lu(k,328) + lu(k,329) = lu(k,329) * lu(k,328) + lu(k,330) = lu(k,330) * lu(k,328) + lu(k,331) = lu(k,331) * lu(k,328) + lu(k,332) = lu(k,332) * lu(k,328) + lu(k,333) = lu(k,333) * lu(k,328) + lu(k,334) = lu(k,334) * lu(k,328) + lu(k,844) = - lu(k,329) * lu(k,840) + lu(k,853) = lu(k,853) - lu(k,330) * lu(k,840) + lu(k,858) = lu(k,858) - lu(k,331) * lu(k,840) + lu(k,861) = - lu(k,332) * lu(k,840) + lu(k,863) = lu(k,863) - lu(k,333) * lu(k,840) + lu(k,866) = - lu(k,334) * lu(k,840) + lu(k,921) = lu(k,921) - lu(k,329) * lu(k,912) + lu(k,938) = lu(k,938) - lu(k,330) * lu(k,912) + lu(k,943) = lu(k,943) - lu(k,331) * lu(k,912) + lu(k,946) = lu(k,946) - lu(k,332) * lu(k,912) + lu(k,948) = lu(k,948) - lu(k,333) * lu(k,912) + lu(k,951) = lu(k,951) - lu(k,334) * lu(k,912) + lu(k,984) = - lu(k,329) * lu(k,980) + lu(k,1004) = lu(k,1004) - lu(k,330) * lu(k,980) + lu(k,1009) = lu(k,1009) - lu(k,331) * lu(k,980) + lu(k,1012) = lu(k,1012) - lu(k,332) * lu(k,980) + lu(k,1014) = lu(k,1014) - lu(k,333) * lu(k,980) + lu(k,1017) = lu(k,1017) - lu(k,334) * lu(k,980) + lu(k,1142) = lu(k,1142) - lu(k,329) * lu(k,1130) + lu(k,1162) = lu(k,1162) - lu(k,330) * lu(k,1130) + lu(k,1167) = lu(k,1167) - lu(k,331) * lu(k,1130) + lu(k,1170) = lu(k,1170) - lu(k,332) * lu(k,1130) + lu(k,1172) = lu(k,1172) - lu(k,333) * lu(k,1130) + lu(k,1175) = lu(k,1175) - lu(k,334) * lu(k,1130) + lu(k,1257) = lu(k,1257) - lu(k,329) * lu(k,1250) + lu(k,1273) = lu(k,1273) - lu(k,330) * lu(k,1250) + lu(k,1278) = lu(k,1278) - lu(k,331) * lu(k,1250) + lu(k,1281) = lu(k,1281) - lu(k,332) * lu(k,1250) + lu(k,1283) = lu(k,1283) - lu(k,333) * lu(k,1250) + lu(k,1286) = lu(k,1286) - lu(k,334) * lu(k,1250) + lu(k,336) = 1._r8 / lu(k,336) + lu(k,337) = lu(k,337) * lu(k,336) + lu(k,338) = lu(k,338) * lu(k,336) + lu(k,339) = lu(k,339) * lu(k,336) + lu(k,340) = lu(k,340) * lu(k,336) + lu(k,460) = lu(k,460) - lu(k,337) * lu(k,458) + lu(k,462) = lu(k,462) - lu(k,338) * lu(k,458) + lu(k,463) = lu(k,463) - lu(k,339) * lu(k,458) + lu(k,464) = lu(k,464) - lu(k,340) * lu(k,458) + lu(k,577) = lu(k,577) - lu(k,337) * lu(k,574) + lu(k,583) = lu(k,583) - lu(k,338) * lu(k,574) + lu(k,584) = lu(k,584) - lu(k,339) * lu(k,574) + lu(k,586) = lu(k,586) - lu(k,340) * lu(k,574) + lu(k,622) = - lu(k,337) * lu(k,618) + lu(k,633) = - lu(k,338) * lu(k,618) + lu(k,634) = lu(k,634) - lu(k,339) * lu(k,618) + lu(k,637) = lu(k,637) - lu(k,340) * lu(k,618) + lu(k,688) = lu(k,688) - lu(k,337) * lu(k,685) + lu(k,699) = lu(k,699) - lu(k,338) * lu(k,685) + lu(k,700) = lu(k,700) - lu(k,339) * lu(k,685) + lu(k,703) = lu(k,703) - lu(k,340) * lu(k,685) + lu(k,743) = lu(k,743) - lu(k,337) * lu(k,736) + lu(k,758) = lu(k,758) - lu(k,338) * lu(k,736) + lu(k,759) = lu(k,759) - lu(k,339) * lu(k,736) + lu(k,763) = lu(k,763) - lu(k,340) * lu(k,736) + lu(k,1147) = lu(k,1147) - lu(k,337) * lu(k,1131) + lu(k,1166) = lu(k,1166) - lu(k,338) * lu(k,1131) + lu(k,1167) = lu(k,1167) - lu(k,339) * lu(k,1131) + lu(k,1172) = lu(k,1172) - lu(k,340) * lu(k,1131) + lu(k,1192) = lu(k,1192) - lu(k,337) * lu(k,1182) + lu(k,1210) = lu(k,1210) - lu(k,338) * lu(k,1182) + lu(k,1211) = lu(k,1211) - lu(k,339) * lu(k,1182) + lu(k,1216) = lu(k,1216) - lu(k,340) * lu(k,1182) + lu(k,1261) = lu(k,1261) - lu(k,337) * lu(k,1251) + lu(k,1277) = lu(k,1277) - lu(k,338) * lu(k,1251) + lu(k,1278) = lu(k,1278) - lu(k,339) * lu(k,1251) + lu(k,1283) = lu(k,1283) - lu(k,340) * lu(k,1251) + lu(k,342) = 1._r8 / lu(k,342) + lu(k,343) = lu(k,343) * lu(k,342) + lu(k,344) = lu(k,344) * lu(k,342) + lu(k,345) = lu(k,345) * lu(k,342) + lu(k,346) = lu(k,346) * lu(k,342) + lu(k,347) = lu(k,347) * lu(k,342) + lu(k,348) = lu(k,348) * lu(k,342) + lu(k,349) = lu(k,349) * lu(k,342) + lu(k,350) = lu(k,350) * lu(k,342) + lu(k,527) = - lu(k,343) * lu(k,525) + lu(k,531) = lu(k,531) - lu(k,344) * lu(k,525) + lu(k,536) = lu(k,536) - lu(k,345) * lu(k,525) + lu(k,540) = lu(k,540) - lu(k,346) * lu(k,525) + lu(k,542) = lu(k,542) - lu(k,347) * lu(k,525) + lu(k,544) = lu(k,544) - lu(k,348) * lu(k,525) + lu(k,546) = - lu(k,349) * lu(k,525) + lu(k,547) = lu(k,547) - lu(k,350) * lu(k,525) + lu(k,924) = lu(k,924) - lu(k,343) * lu(k,913) + lu(k,927) = lu(k,927) - lu(k,344) * lu(k,913) + lu(k,938) = lu(k,938) - lu(k,345) * lu(k,913) + lu(k,943) = lu(k,943) - lu(k,346) * lu(k,913) + lu(k,946) = lu(k,946) - lu(k,347) * lu(k,913) + lu(k,948) = lu(k,948) - lu(k,348) * lu(k,913) + lu(k,951) = lu(k,951) - lu(k,349) * lu(k,913) + lu(k,952) = lu(k,952) - lu(k,350) * lu(k,913) + lu(k,1146) = lu(k,1146) - lu(k,343) * lu(k,1132) + lu(k,1150) = lu(k,1150) - lu(k,344) * lu(k,1132) + lu(k,1162) = lu(k,1162) - lu(k,345) * lu(k,1132) + lu(k,1167) = lu(k,1167) - lu(k,346) * lu(k,1132) + lu(k,1170) = lu(k,1170) - lu(k,347) * lu(k,1132) + lu(k,1172) = lu(k,1172) - lu(k,348) * lu(k,1132) + lu(k,1175) = lu(k,1175) - lu(k,349) * lu(k,1132) + lu(k,1176) = lu(k,1176) - lu(k,350) * lu(k,1132) + lu(k,1260) = lu(k,1260) - lu(k,343) * lu(k,1252) + lu(k,1262) = lu(k,1262) - lu(k,344) * lu(k,1252) + lu(k,1273) = lu(k,1273) - lu(k,345) * lu(k,1252) + lu(k,1278) = lu(k,1278) - lu(k,346) * lu(k,1252) + lu(k,1281) = lu(k,1281) - lu(k,347) * lu(k,1252) + lu(k,1283) = lu(k,1283) - lu(k,348) * lu(k,1252) + lu(k,1286) = lu(k,1286) - lu(k,349) * lu(k,1252) + lu(k,1287) = - lu(k,350) * lu(k,1252) + end do + end subroutine lu_fac08 + subroutine lu_fac09( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,352) = 1._r8 / lu(k,352) + lu(k,353) = lu(k,353) * lu(k,352) + lu(k,354) = lu(k,354) * lu(k,352) + lu(k,355) = lu(k,355) * lu(k,352) + lu(k,356) = lu(k,356) * lu(k,352) + lu(k,357) = lu(k,357) * lu(k,352) + lu(k,358) = lu(k,358) * lu(k,352) + lu(k,359) = lu(k,359) * lu(k,352) + lu(k,819) = lu(k,819) - lu(k,353) * lu(k,814) + lu(k,820) = lu(k,820) - lu(k,354) * lu(k,814) + lu(k,821) = lu(k,821) - lu(k,355) * lu(k,814) + lu(k,822) = lu(k,822) - lu(k,356) * lu(k,814) + lu(k,824) = - lu(k,357) * lu(k,814) + lu(k,828) = lu(k,828) - lu(k,358) * lu(k,814) + lu(k,831) = lu(k,831) - lu(k,359) * lu(k,814) + lu(k,883) = lu(k,883) - lu(k,353) * lu(k,872) + lu(k,884) = lu(k,884) - lu(k,354) * lu(k,872) + lu(k,885) = lu(k,885) - lu(k,355) * lu(k,872) + lu(k,886) = lu(k,886) - lu(k,356) * lu(k,872) + lu(k,888) = lu(k,888) - lu(k,357) * lu(k,872) + lu(k,892) = lu(k,892) - lu(k,358) * lu(k,872) + lu(k,896) = lu(k,896) - lu(k,359) * lu(k,872) + lu(k,939) = lu(k,939) - lu(k,353) * lu(k,914) + lu(k,940) = lu(k,940) - lu(k,354) * lu(k,914) + lu(k,941) = lu(k,941) - lu(k,355) * lu(k,914) + lu(k,942) = lu(k,942) - lu(k,356) * lu(k,914) + lu(k,944) = lu(k,944) - lu(k,357) * lu(k,914) + lu(k,948) = lu(k,948) - lu(k,358) * lu(k,914) + lu(k,952) = lu(k,952) - lu(k,359) * lu(k,914) + lu(k,961) = lu(k,961) - lu(k,353) * lu(k,956) + lu(k,962) = - lu(k,354) * lu(k,956) + lu(k,963) = lu(k,963) - lu(k,355) * lu(k,956) + lu(k,964) = lu(k,964) - lu(k,356) * lu(k,956) + lu(k,966) = lu(k,966) - lu(k,357) * lu(k,956) + lu(k,970) = lu(k,970) - lu(k,358) * lu(k,956) + lu(k,974) = - lu(k,359) * lu(k,956) + lu(k,1041) = lu(k,1041) - lu(k,353) * lu(k,1027) + lu(k,1042) = - lu(k,354) * lu(k,1027) + lu(k,1043) = - lu(k,355) * lu(k,1027) + lu(k,1044) = lu(k,1044) - lu(k,356) * lu(k,1027) + lu(k,1046) = lu(k,1046) - lu(k,357) * lu(k,1027) + lu(k,1050) = lu(k,1050) - lu(k,358) * lu(k,1027) + lu(k,1054) = lu(k,1054) - lu(k,359) * lu(k,1027) + lu(k,360) = 1._r8 / lu(k,360) + lu(k,361) = lu(k,361) * lu(k,360) + lu(k,362) = lu(k,362) * lu(k,360) + lu(k,363) = lu(k,363) * lu(k,360) + lu(k,364) = lu(k,364) * lu(k,360) + lu(k,365) = lu(k,365) * lu(k,360) + lu(k,390) = - lu(k,361) * lu(k,388) + lu(k,392) = - lu(k,362) * lu(k,388) + lu(k,393) = lu(k,393) - lu(k,363) * lu(k,388) + lu(k,397) = lu(k,397) - lu(k,364) * lu(k,388) + lu(k,399) = lu(k,399) - lu(k,365) * lu(k,388) + lu(k,741) = lu(k,741) - lu(k,361) * lu(k,737) + lu(k,751) = lu(k,751) - lu(k,362) * lu(k,737) + lu(k,753) = lu(k,753) - lu(k,363) * lu(k,737) + lu(k,763) = lu(k,763) - lu(k,364) * lu(k,737) + lu(k,767) = lu(k,767) - lu(k,365) * lu(k,737) + lu(k,923) = lu(k,923) - lu(k,361) * lu(k,915) + lu(k,934) = lu(k,934) - lu(k,362) * lu(k,915) + lu(k,936) = lu(k,936) - lu(k,363) * lu(k,915) + lu(k,948) = lu(k,948) - lu(k,364) * lu(k,915) + lu(k,952) = lu(k,952) - lu(k,365) * lu(k,915) + lu(k,987) = - lu(k,361) * lu(k,981) + lu(k,1000) = lu(k,1000) - lu(k,362) * lu(k,981) + lu(k,1002) = lu(k,1002) - lu(k,363) * lu(k,981) + lu(k,1014) = lu(k,1014) - lu(k,364) * lu(k,981) + lu(k,1018) = lu(k,1018) - lu(k,365) * lu(k,981) + lu(k,1145) = lu(k,1145) - lu(k,361) * lu(k,1133) + lu(k,1158) = lu(k,1158) - lu(k,362) * lu(k,1133) + lu(k,1160) = lu(k,1160) - lu(k,363) * lu(k,1133) + lu(k,1172) = lu(k,1172) - lu(k,364) * lu(k,1133) + lu(k,1176) = lu(k,1176) - lu(k,365) * lu(k,1133) + lu(k,1190) = - lu(k,361) * lu(k,1183) + lu(k,1202) = lu(k,1202) - lu(k,362) * lu(k,1183) + lu(k,1204) = - lu(k,363) * lu(k,1183) + lu(k,1216) = lu(k,1216) - lu(k,364) * lu(k,1183) + lu(k,1220) = - lu(k,365) * lu(k,1183) + lu(k,1259) = lu(k,1259) - lu(k,361) * lu(k,1253) + lu(k,1269) = lu(k,1269) - lu(k,362) * lu(k,1253) + lu(k,1271) = lu(k,1271) - lu(k,363) * lu(k,1253) + lu(k,1283) = lu(k,1283) - lu(k,364) * lu(k,1253) + lu(k,1287) = lu(k,1287) - lu(k,365) * lu(k,1253) + lu(k,369) = 1._r8 / lu(k,369) + lu(k,370) = lu(k,370) * lu(k,369) + lu(k,371) = lu(k,371) * lu(k,369) + lu(k,372) = lu(k,372) * lu(k,369) + lu(k,373) = lu(k,373) * lu(k,369) + lu(k,374) = lu(k,374) * lu(k,369) + lu(k,375) = lu(k,375) * lu(k,369) + lu(k,376) = lu(k,376) * lu(k,369) + lu(k,744) = lu(k,744) - lu(k,370) * lu(k,738) + lu(k,753) = lu(k,753) - lu(k,371) * lu(k,738) + lu(k,755) = lu(k,755) - lu(k,372) * lu(k,738) + lu(k,759) = lu(k,759) - lu(k,373) * lu(k,738) + lu(k,761) = lu(k,761) - lu(k,374) * lu(k,738) + lu(k,763) = lu(k,763) - lu(k,375) * lu(k,738) + lu(k,766) = lu(k,766) - lu(k,376) * lu(k,738) + lu(k,848) = - lu(k,370) * lu(k,841) + lu(k,851) = lu(k,851) - lu(k,371) * lu(k,841) + lu(k,853) = lu(k,853) - lu(k,372) * lu(k,841) + lu(k,858) = lu(k,858) - lu(k,373) * lu(k,841) + lu(k,861) = lu(k,861) - lu(k,374) * lu(k,841) + lu(k,863) = lu(k,863) - lu(k,375) * lu(k,841) + lu(k,866) = lu(k,866) - lu(k,376) * lu(k,841) + lu(k,927) = lu(k,927) - lu(k,370) * lu(k,916) + lu(k,936) = lu(k,936) - lu(k,371) * lu(k,916) + lu(k,938) = lu(k,938) - lu(k,372) * lu(k,916) + lu(k,943) = lu(k,943) - lu(k,373) * lu(k,916) + lu(k,946) = lu(k,946) - lu(k,374) * lu(k,916) + lu(k,948) = lu(k,948) - lu(k,375) * lu(k,916) + lu(k,951) = lu(k,951) - lu(k,376) * lu(k,916) + lu(k,1150) = lu(k,1150) - lu(k,370) * lu(k,1134) + lu(k,1160) = lu(k,1160) - lu(k,371) * lu(k,1134) + lu(k,1162) = lu(k,1162) - lu(k,372) * lu(k,1134) + lu(k,1167) = lu(k,1167) - lu(k,373) * lu(k,1134) + lu(k,1170) = lu(k,1170) - lu(k,374) * lu(k,1134) + lu(k,1172) = lu(k,1172) - lu(k,375) * lu(k,1134) + lu(k,1175) = lu(k,1175) - lu(k,376) * lu(k,1134) + lu(k,1262) = lu(k,1262) - lu(k,370) * lu(k,1254) + lu(k,1271) = lu(k,1271) - lu(k,371) * lu(k,1254) + lu(k,1273) = lu(k,1273) - lu(k,372) * lu(k,1254) + lu(k,1278) = lu(k,1278) - lu(k,373) * lu(k,1254) + lu(k,1281) = lu(k,1281) - lu(k,374) * lu(k,1254) + lu(k,1283) = lu(k,1283) - lu(k,375) * lu(k,1254) + lu(k,1286) = lu(k,1286) - lu(k,376) * lu(k,1254) + lu(k,377) = 1._r8 / lu(k,377) + lu(k,378) = lu(k,378) * lu(k,377) + lu(k,379) = lu(k,379) * lu(k,377) + lu(k,380) = lu(k,380) * lu(k,377) + lu(k,381) = lu(k,381) * lu(k,377) + lu(k,382) = lu(k,382) * lu(k,377) + lu(k,383) = lu(k,383) * lu(k,377) + lu(k,384) = lu(k,384) * lu(k,377) + lu(k,385) = lu(k,385) * lu(k,377) + lu(k,386) = lu(k,386) * lu(k,377) + lu(k,430) = - lu(k,378) * lu(k,428) + lu(k,433) = lu(k,433) - lu(k,379) * lu(k,428) + lu(k,436) = lu(k,436) - lu(k,380) * lu(k,428) + lu(k,438) = lu(k,438) - lu(k,381) * lu(k,428) + lu(k,439) = lu(k,439) - lu(k,382) * lu(k,428) + lu(k,441) = - lu(k,383) * lu(k,428) + lu(k,442) = lu(k,442) - lu(k,384) * lu(k,428) + lu(k,443) = lu(k,443) - lu(k,385) * lu(k,428) + lu(k,444) = - lu(k,386) * lu(k,428) + lu(k,922) = lu(k,922) - lu(k,378) * lu(k,917) + lu(k,928) = lu(k,928) - lu(k,379) * lu(k,917) + lu(k,935) = lu(k,935) - lu(k,380) * lu(k,917) + lu(k,938) = lu(k,938) - lu(k,381) * lu(k,917) + lu(k,943) = lu(k,943) - lu(k,382) * lu(k,917) + lu(k,946) = lu(k,946) - lu(k,383) * lu(k,917) + lu(k,948) = lu(k,948) - lu(k,384) * lu(k,917) + lu(k,949) = lu(k,949) - lu(k,385) * lu(k,917) + lu(k,951) = lu(k,951) - lu(k,386) * lu(k,917) + lu(k,1189) = lu(k,1189) - lu(k,378) * lu(k,1184) + lu(k,1195) = lu(k,1195) - lu(k,379) * lu(k,1184) + lu(k,1203) = lu(k,1203) - lu(k,380) * lu(k,1184) + lu(k,1206) = lu(k,1206) - lu(k,381) * lu(k,1184) + lu(k,1211) = lu(k,1211) - lu(k,382) * lu(k,1184) + lu(k,1214) = lu(k,1214) - lu(k,383) * lu(k,1184) + lu(k,1216) = lu(k,1216) - lu(k,384) * lu(k,1184) + lu(k,1217) = lu(k,1217) - lu(k,385) * lu(k,1184) + lu(k,1219) = lu(k,1219) - lu(k,386) * lu(k,1184) + lu(k,1258) = lu(k,1258) - lu(k,378) * lu(k,1255) + lu(k,1263) = lu(k,1263) - lu(k,379) * lu(k,1255) + lu(k,1270) = lu(k,1270) - lu(k,380) * lu(k,1255) + lu(k,1273) = lu(k,1273) - lu(k,381) * lu(k,1255) + lu(k,1278) = lu(k,1278) - lu(k,382) * lu(k,1255) + lu(k,1281) = lu(k,1281) - lu(k,383) * lu(k,1255) + lu(k,1283) = lu(k,1283) - lu(k,384) * lu(k,1255) + lu(k,1284) = lu(k,1284) - lu(k,385) * lu(k,1255) + lu(k,1286) = lu(k,1286) - lu(k,386) * lu(k,1255) + lu(k,389) = 1._r8 / lu(k,389) + lu(k,390) = lu(k,390) * lu(k,389) + lu(k,391) = lu(k,391) * lu(k,389) + lu(k,392) = lu(k,392) * lu(k,389) + lu(k,393) = lu(k,393) * lu(k,389) + lu(k,394) = lu(k,394) * lu(k,389) + lu(k,395) = lu(k,395) * lu(k,389) + lu(k,396) = lu(k,396) * lu(k,389) + lu(k,397) = lu(k,397) * lu(k,389) + lu(k,398) = lu(k,398) * lu(k,389) + lu(k,399) = lu(k,399) * lu(k,389) + lu(k,741) = lu(k,741) - lu(k,390) * lu(k,739) + lu(k,744) = lu(k,744) - lu(k,391) * lu(k,739) + lu(k,751) = lu(k,751) - lu(k,392) * lu(k,739) + lu(k,753) = lu(k,753) - lu(k,393) * lu(k,739) + lu(k,755) = lu(k,755) - lu(k,394) * lu(k,739) + lu(k,759) = lu(k,759) - lu(k,395) * lu(k,739) + lu(k,761) = lu(k,761) - lu(k,396) * lu(k,739) + lu(k,763) = lu(k,763) - lu(k,397) * lu(k,739) + lu(k,766) = lu(k,766) - lu(k,398) * lu(k,739) + lu(k,767) = lu(k,767) - lu(k,399) * lu(k,739) + lu(k,923) = lu(k,923) - lu(k,390) * lu(k,918) + lu(k,927) = lu(k,927) - lu(k,391) * lu(k,918) + lu(k,934) = lu(k,934) - lu(k,392) * lu(k,918) + lu(k,936) = lu(k,936) - lu(k,393) * lu(k,918) + lu(k,938) = lu(k,938) - lu(k,394) * lu(k,918) + lu(k,943) = lu(k,943) - lu(k,395) * lu(k,918) + lu(k,946) = lu(k,946) - lu(k,396) * lu(k,918) + lu(k,948) = lu(k,948) - lu(k,397) * lu(k,918) + lu(k,951) = lu(k,951) - lu(k,398) * lu(k,918) + lu(k,952) = lu(k,952) - lu(k,399) * lu(k,918) + lu(k,1145) = lu(k,1145) - lu(k,390) * lu(k,1135) + lu(k,1150) = lu(k,1150) - lu(k,391) * lu(k,1135) + lu(k,1158) = lu(k,1158) - lu(k,392) * lu(k,1135) + lu(k,1160) = lu(k,1160) - lu(k,393) * lu(k,1135) + lu(k,1162) = lu(k,1162) - lu(k,394) * lu(k,1135) + lu(k,1167) = lu(k,1167) - lu(k,395) * lu(k,1135) + lu(k,1170) = lu(k,1170) - lu(k,396) * lu(k,1135) + lu(k,1172) = lu(k,1172) - lu(k,397) * lu(k,1135) + lu(k,1175) = lu(k,1175) - lu(k,398) * lu(k,1135) + lu(k,1176) = lu(k,1176) - lu(k,399) * lu(k,1135) + lu(k,1259) = lu(k,1259) - lu(k,390) * lu(k,1256) + lu(k,1262) = lu(k,1262) - lu(k,391) * lu(k,1256) + lu(k,1269) = lu(k,1269) - lu(k,392) * lu(k,1256) + lu(k,1271) = lu(k,1271) - lu(k,393) * lu(k,1256) + lu(k,1273) = lu(k,1273) - lu(k,394) * lu(k,1256) + lu(k,1278) = lu(k,1278) - lu(k,395) * lu(k,1256) + lu(k,1281) = lu(k,1281) - lu(k,396) * lu(k,1256) + lu(k,1283) = lu(k,1283) - lu(k,397) * lu(k,1256) + lu(k,1286) = lu(k,1286) - lu(k,398) * lu(k,1256) + lu(k,1287) = lu(k,1287) - lu(k,399) * lu(k,1256) + end do + end subroutine lu_fac09 + subroutine lu_fac10( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,401) = 1._r8 / lu(k,401) + lu(k,402) = lu(k,402) * lu(k,401) + lu(k,403) = lu(k,403) * lu(k,401) + lu(k,404) = lu(k,404) * lu(k,401) + lu(k,405) = lu(k,405) * lu(k,401) + lu(k,406) = lu(k,406) * lu(k,401) + lu(k,407) = lu(k,407) * lu(k,401) + lu(k,449) = lu(k,449) - lu(k,402) * lu(k,446) + lu(k,450) = lu(k,450) - lu(k,403) * lu(k,446) + lu(k,451) = lu(k,451) - lu(k,404) * lu(k,446) + lu(k,453) = lu(k,453) - lu(k,405) * lu(k,446) + lu(k,455) = lu(k,455) - lu(k,406) * lu(k,446) + lu(k,456) = - lu(k,407) * lu(k,446) + lu(k,820) = lu(k,820) - lu(k,402) * lu(k,815) + lu(k,821) = lu(k,821) - lu(k,403) * lu(k,815) + lu(k,822) = lu(k,822) - lu(k,404) * lu(k,815) + lu(k,828) = lu(k,828) - lu(k,405) * lu(k,815) + lu(k,830) = lu(k,830) - lu(k,406) * lu(k,815) + lu(k,831) = lu(k,831) - lu(k,407) * lu(k,815) + lu(k,855) = lu(k,855) - lu(k,402) * lu(k,842) + lu(k,856) = lu(k,856) - lu(k,403) * lu(k,842) + lu(k,857) = lu(k,857) - lu(k,404) * lu(k,842) + lu(k,863) = lu(k,863) - lu(k,405) * lu(k,842) + lu(k,865) = lu(k,865) - lu(k,406) * lu(k,842) + lu(k,867) = lu(k,867) - lu(k,407) * lu(k,842) + lu(k,884) = lu(k,884) - lu(k,402) * lu(k,873) + lu(k,885) = lu(k,885) - lu(k,403) * lu(k,873) + lu(k,886) = lu(k,886) - lu(k,404) * lu(k,873) + lu(k,892) = lu(k,892) - lu(k,405) * lu(k,873) + lu(k,894) = lu(k,894) - lu(k,406) * lu(k,873) + lu(k,896) = lu(k,896) - lu(k,407) * lu(k,873) + lu(k,940) = lu(k,940) - lu(k,402) * lu(k,919) + lu(k,941) = lu(k,941) - lu(k,403) * lu(k,919) + lu(k,942) = lu(k,942) - lu(k,404) * lu(k,919) + lu(k,948) = lu(k,948) - lu(k,405) * lu(k,919) + lu(k,950) = lu(k,950) - lu(k,406) * lu(k,919) + lu(k,952) = lu(k,952) - lu(k,407) * lu(k,919) + lu(k,1164) = lu(k,1164) - lu(k,402) * lu(k,1136) + lu(k,1165) = lu(k,1165) - lu(k,403) * lu(k,1136) + lu(k,1166) = lu(k,1166) - lu(k,404) * lu(k,1136) + lu(k,1172) = lu(k,1172) - lu(k,405) * lu(k,1136) + lu(k,1174) = lu(k,1174) - lu(k,406) * lu(k,1136) + lu(k,1176) = lu(k,1176) - lu(k,407) * lu(k,1136) + lu(k,1233) = lu(k,1233) - lu(k,402) * lu(k,1225) + lu(k,1234) = lu(k,1234) - lu(k,403) * lu(k,1225) + lu(k,1235) = lu(k,1235) - lu(k,404) * lu(k,1225) + lu(k,1241) = lu(k,1241) - lu(k,405) * lu(k,1225) + lu(k,1243) = lu(k,1243) - lu(k,406) * lu(k,1225) + lu(k,1245) = - lu(k,407) * lu(k,1225) + lu(k,408) = 1._r8 / lu(k,408) + lu(k,409) = lu(k,409) * lu(k,408) + lu(k,410) = lu(k,410) * lu(k,408) + lu(k,411) = lu(k,411) * lu(k,408) + lu(k,412) = lu(k,412) * lu(k,408) + lu(k,413) = lu(k,413) * lu(k,408) + lu(k,414) = lu(k,414) * lu(k,408) + lu(k,415) = lu(k,415) * lu(k,408) + lu(k,782) = lu(k,782) - lu(k,409) * lu(k,778) + lu(k,784) = lu(k,784) - lu(k,410) * lu(k,778) + lu(k,787) = lu(k,787) - lu(k,411) * lu(k,778) + lu(k,789) = - lu(k,412) * lu(k,778) + lu(k,792) = - lu(k,413) * lu(k,778) + lu(k,793) = lu(k,793) - lu(k,414) * lu(k,778) + lu(k,795) = lu(k,795) - lu(k,415) * lu(k,778) + lu(k,798) = - lu(k,409) * lu(k,796) + lu(k,800) = lu(k,800) - lu(k,410) * lu(k,796) + lu(k,803) = - lu(k,411) * lu(k,796) + lu(k,805) = lu(k,805) - lu(k,412) * lu(k,796) + lu(k,808) = - lu(k,413) * lu(k,796) + lu(k,809) = - lu(k,414) * lu(k,796) + lu(k,811) = - lu(k,415) * lu(k,796) + lu(k,881) = lu(k,881) - lu(k,409) * lu(k,874) + lu(k,883) = lu(k,883) - lu(k,410) * lu(k,874) + lu(k,886) = lu(k,886) - lu(k,411) * lu(k,874) + lu(k,888) = lu(k,888) - lu(k,412) * lu(k,874) + lu(k,891) = - lu(k,413) * lu(k,874) + lu(k,892) = lu(k,892) - lu(k,414) * lu(k,874) + lu(k,896) = lu(k,896) - lu(k,415) * lu(k,874) + lu(k,937) = lu(k,937) - lu(k,409) * lu(k,920) + lu(k,939) = lu(k,939) - lu(k,410) * lu(k,920) + lu(k,942) = lu(k,942) - lu(k,411) * lu(k,920) + lu(k,944) = lu(k,944) - lu(k,412) * lu(k,920) + lu(k,947) = - lu(k,413) * lu(k,920) + lu(k,948) = lu(k,948) - lu(k,414) * lu(k,920) + lu(k,952) = lu(k,952) - lu(k,415) * lu(k,920) + lu(k,1076) = lu(k,1076) - lu(k,409) * lu(k,1071) + lu(k,1078) = lu(k,1078) - lu(k,410) * lu(k,1071) + lu(k,1081) = lu(k,1081) - lu(k,411) * lu(k,1071) + lu(k,1083) = lu(k,1083) - lu(k,412) * lu(k,1071) + lu(k,1086) = lu(k,1086) - lu(k,413) * lu(k,1071) + lu(k,1087) = lu(k,1087) - lu(k,414) * lu(k,1071) + lu(k,1091) = lu(k,1091) - lu(k,415) * lu(k,1071) + lu(k,1161) = lu(k,1161) - lu(k,409) * lu(k,1137) + lu(k,1163) = lu(k,1163) - lu(k,410) * lu(k,1137) + lu(k,1166) = lu(k,1166) - lu(k,411) * lu(k,1137) + lu(k,1168) = lu(k,1168) - lu(k,412) * lu(k,1137) + lu(k,1171) = lu(k,1171) - lu(k,413) * lu(k,1137) + lu(k,1172) = lu(k,1172) - lu(k,414) * lu(k,1137) + lu(k,1176) = lu(k,1176) - lu(k,415) * lu(k,1137) + lu(k,416) = 1._r8 / lu(k,416) + lu(k,417) = lu(k,417) * lu(k,416) + lu(k,418) = lu(k,418) * lu(k,416) + lu(k,419) = lu(k,419) * lu(k,416) + lu(k,420) = lu(k,420) * lu(k,416) + lu(k,452) = lu(k,452) - lu(k,417) * lu(k,447) + lu(k,453) = lu(k,453) - lu(k,418) * lu(k,447) + lu(k,454) = lu(k,454) - lu(k,419) * lu(k,447) + lu(k,456) = lu(k,456) - lu(k,420) * lu(k,447) + lu(k,472) = lu(k,472) - lu(k,417) * lu(k,466) + lu(k,473) = lu(k,473) - lu(k,418) * lu(k,466) + lu(k,474) = lu(k,474) - lu(k,419) * lu(k,466) + lu(k,475) = - lu(k,420) * lu(k,466) + lu(k,555) = - lu(k,417) * lu(k,548) + lu(k,556) = lu(k,556) - lu(k,418) * lu(k,548) + lu(k,557) = lu(k,557) - lu(k,419) * lu(k,548) + lu(k,558) = lu(k,558) - lu(k,420) * lu(k,548) + lu(k,595) = - lu(k,417) * lu(k,589) + lu(k,596) = lu(k,596) - lu(k,418) * lu(k,589) + lu(k,597) = lu(k,597) - lu(k,419) * lu(k,589) + lu(k,598) = lu(k,598) - lu(k,420) * lu(k,589) + lu(k,791) = - lu(k,417) * lu(k,779) + lu(k,793) = lu(k,793) - lu(k,418) * lu(k,779) + lu(k,794) = lu(k,794) - lu(k,419) * lu(k,779) + lu(k,795) = lu(k,795) - lu(k,420) * lu(k,779) + lu(k,826) = - lu(k,417) * lu(k,816) + lu(k,828) = lu(k,828) - lu(k,418) * lu(k,816) + lu(k,829) = - lu(k,419) * lu(k,816) + lu(k,831) = lu(k,831) - lu(k,420) * lu(k,816) + lu(k,890) = lu(k,890) - lu(k,417) * lu(k,875) + lu(k,892) = lu(k,892) - lu(k,418) * lu(k,875) + lu(k,893) = lu(k,893) - lu(k,419) * lu(k,875) + lu(k,896) = lu(k,896) - lu(k,420) * lu(k,875) + lu(k,968) = lu(k,968) - lu(k,417) * lu(k,957) + lu(k,970) = lu(k,970) - lu(k,418) * lu(k,957) + lu(k,971) = lu(k,971) - lu(k,419) * lu(k,957) + lu(k,974) = lu(k,974) - lu(k,420) * lu(k,957) + lu(k,1048) = lu(k,1048) - lu(k,417) * lu(k,1028) + lu(k,1050) = lu(k,1050) - lu(k,418) * lu(k,1028) + lu(k,1051) = lu(k,1051) - lu(k,419) * lu(k,1028) + lu(k,1054) = lu(k,1054) - lu(k,420) * lu(k,1028) + lu(k,1170) = lu(k,1170) - lu(k,417) * lu(k,1138) + lu(k,1172) = lu(k,1172) - lu(k,418) * lu(k,1138) + lu(k,1173) = lu(k,1173) - lu(k,419) * lu(k,1138) + lu(k,1176) = lu(k,1176) - lu(k,420) * lu(k,1138) + lu(k,1214) = lu(k,1214) - lu(k,417) * lu(k,1185) + lu(k,1216) = lu(k,1216) - lu(k,418) * lu(k,1185) + lu(k,1217) = lu(k,1217) - lu(k,419) * lu(k,1185) + lu(k,1220) = lu(k,1220) - lu(k,420) * lu(k,1185) + lu(k,422) = 1._r8 / lu(k,422) + lu(k,423) = lu(k,423) * lu(k,422) + lu(k,424) = lu(k,424) * lu(k,422) + lu(k,425) = lu(k,425) * lu(k,422) + lu(k,426) = lu(k,426) * lu(k,422) + lu(k,427) = lu(k,427) * lu(k,422) + lu(k,602) = lu(k,602) - lu(k,423) * lu(k,601) + lu(k,606) = lu(k,606) - lu(k,424) * lu(k,601) + lu(k,607) = - lu(k,425) * lu(k,601) + lu(k,611) = lu(k,611) - lu(k,426) * lu(k,601) + lu(k,614) = - lu(k,427) * lu(k,601) + lu(k,880) = lu(k,880) - lu(k,423) * lu(k,876) + lu(k,886) = lu(k,886) - lu(k,424) * lu(k,876) + lu(k,887) = lu(k,887) - lu(k,425) * lu(k,876) + lu(k,892) = lu(k,892) - lu(k,426) * lu(k,876) + lu(k,896) = lu(k,896) - lu(k,427) * lu(k,876) + lu(k,959) = lu(k,959) - lu(k,423) * lu(k,958) + lu(k,964) = lu(k,964) - lu(k,424) * lu(k,958) + lu(k,965) = lu(k,965) - lu(k,425) * lu(k,958) + lu(k,970) = lu(k,970) - lu(k,426) * lu(k,958) + lu(k,974) = lu(k,974) - lu(k,427) * lu(k,958) + lu(k,996) = lu(k,996) - lu(k,423) * lu(k,982) + lu(k,1008) = lu(k,1008) - lu(k,424) * lu(k,982) + lu(k,1009) = lu(k,1009) - lu(k,425) * lu(k,982) + lu(k,1014) = lu(k,1014) - lu(k,426) * lu(k,982) + lu(k,1018) = lu(k,1018) - lu(k,427) * lu(k,982) + lu(k,1034) = lu(k,1034) - lu(k,423) * lu(k,1029) + lu(k,1044) = lu(k,1044) - lu(k,424) * lu(k,1029) + lu(k,1045) = lu(k,1045) - lu(k,425) * lu(k,1029) + lu(k,1050) = lu(k,1050) - lu(k,426) * lu(k,1029) + lu(k,1054) = lu(k,1054) - lu(k,427) * lu(k,1029) + lu(k,1154) = lu(k,1154) - lu(k,423) * lu(k,1139) + lu(k,1166) = lu(k,1166) - lu(k,424) * lu(k,1139) + lu(k,1167) = lu(k,1167) - lu(k,425) * lu(k,1139) + lu(k,1172) = lu(k,1172) - lu(k,426) * lu(k,1139) + lu(k,1176) = lu(k,1176) - lu(k,427) * lu(k,1139) + lu(k,1198) = - lu(k,423) * lu(k,1186) + lu(k,1210) = lu(k,1210) - lu(k,424) * lu(k,1186) + lu(k,1211) = lu(k,1211) - lu(k,425) * lu(k,1186) + lu(k,1216) = lu(k,1216) - lu(k,426) * lu(k,1186) + lu(k,1220) = lu(k,1220) - lu(k,427) * lu(k,1186) + lu(k,1228) = lu(k,1228) - lu(k,423) * lu(k,1226) + lu(k,1235) = lu(k,1235) - lu(k,424) * lu(k,1226) + lu(k,1236) = lu(k,1236) - lu(k,425) * lu(k,1226) + lu(k,1241) = lu(k,1241) - lu(k,426) * lu(k,1226) + lu(k,1245) = lu(k,1245) - lu(k,427) * lu(k,1226) + lu(k,1292) = - lu(k,423) * lu(k,1290) + lu(k,1297) = lu(k,1297) - lu(k,424) * lu(k,1290) + lu(k,1298) = - lu(k,425) * lu(k,1290) + lu(k,1303) = lu(k,1303) - lu(k,426) * lu(k,1290) + lu(k,1307) = lu(k,1307) - lu(k,427) * lu(k,1290) + lu(k,429) = 1._r8 / lu(k,429) + lu(k,430) = lu(k,430) * lu(k,429) + lu(k,431) = lu(k,431) * lu(k,429) + lu(k,432) = lu(k,432) * lu(k,429) + lu(k,433) = lu(k,433) * lu(k,429) + lu(k,434) = lu(k,434) * lu(k,429) + lu(k,435) = lu(k,435) * lu(k,429) + lu(k,436) = lu(k,436) * lu(k,429) + lu(k,437) = lu(k,437) * lu(k,429) + lu(k,438) = lu(k,438) * lu(k,429) + lu(k,439) = lu(k,439) * lu(k,429) + lu(k,440) = lu(k,440) * lu(k,429) + lu(k,441) = lu(k,441) * lu(k,429) + lu(k,442) = lu(k,442) * lu(k,429) + lu(k,443) = lu(k,443) * lu(k,429) + lu(k,444) = lu(k,444) * lu(k,429) + lu(k,985) = - lu(k,430) * lu(k,983) + lu(k,989) = lu(k,989) - lu(k,431) * lu(k,983) + lu(k,991) = lu(k,991) - lu(k,432) * lu(k,983) + lu(k,993) = lu(k,993) - lu(k,433) * lu(k,983) + lu(k,997) = lu(k,997) - lu(k,434) * lu(k,983) + lu(k,1000) = lu(k,1000) - lu(k,435) * lu(k,983) + lu(k,1001) = lu(k,1001) - lu(k,436) * lu(k,983) + lu(k,1002) = lu(k,1002) - lu(k,437) * lu(k,983) + lu(k,1004) = lu(k,1004) - lu(k,438) * lu(k,983) + lu(k,1009) = lu(k,1009) - lu(k,439) * lu(k,983) + lu(k,1011) = lu(k,1011) - lu(k,440) * lu(k,983) + lu(k,1012) = lu(k,1012) - lu(k,441) * lu(k,983) + lu(k,1014) = lu(k,1014) - lu(k,442) * lu(k,983) + lu(k,1015) = lu(k,1015) - lu(k,443) * lu(k,983) + lu(k,1017) = lu(k,1017) - lu(k,444) * lu(k,983) + lu(k,1143) = lu(k,1143) - lu(k,430) * lu(k,1140) + lu(k,1147) = lu(k,1147) - lu(k,431) * lu(k,1140) + lu(k,1149) = lu(k,1149) - lu(k,432) * lu(k,1140) + lu(k,1151) = lu(k,1151) - lu(k,433) * lu(k,1140) + lu(k,1155) = lu(k,1155) - lu(k,434) * lu(k,1140) + lu(k,1158) = lu(k,1158) - lu(k,435) * lu(k,1140) + lu(k,1159) = lu(k,1159) - lu(k,436) * lu(k,1140) + lu(k,1160) = lu(k,1160) - lu(k,437) * lu(k,1140) + lu(k,1162) = lu(k,1162) - lu(k,438) * lu(k,1140) + lu(k,1167) = lu(k,1167) - lu(k,439) * lu(k,1140) + lu(k,1169) = lu(k,1169) - lu(k,440) * lu(k,1140) + lu(k,1170) = lu(k,1170) - lu(k,441) * lu(k,1140) + lu(k,1172) = lu(k,1172) - lu(k,442) * lu(k,1140) + lu(k,1173) = lu(k,1173) - lu(k,443) * lu(k,1140) + lu(k,1175) = lu(k,1175) - lu(k,444) * lu(k,1140) + lu(k,1189) = lu(k,1189) - lu(k,430) * lu(k,1187) + lu(k,1192) = lu(k,1192) - lu(k,431) * lu(k,1187) + lu(k,1193) = lu(k,1193) - lu(k,432) * lu(k,1187) + lu(k,1195) = lu(k,1195) - lu(k,433) * lu(k,1187) + lu(k,1199) = lu(k,1199) - lu(k,434) * lu(k,1187) + lu(k,1202) = lu(k,1202) - lu(k,435) * lu(k,1187) + lu(k,1203) = lu(k,1203) - lu(k,436) * lu(k,1187) + lu(k,1204) = lu(k,1204) - lu(k,437) * lu(k,1187) + lu(k,1206) = lu(k,1206) - lu(k,438) * lu(k,1187) + lu(k,1211) = lu(k,1211) - lu(k,439) * lu(k,1187) + lu(k,1213) = lu(k,1213) - lu(k,440) * lu(k,1187) + lu(k,1214) = lu(k,1214) - lu(k,441) * lu(k,1187) + lu(k,1216) = lu(k,1216) - lu(k,442) * lu(k,1187) + lu(k,1217) = lu(k,1217) - lu(k,443) * lu(k,1187) + lu(k,1219) = lu(k,1219) - lu(k,444) * lu(k,1187) + end do + end subroutine lu_fac10 + subroutine lu_fac11( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,448) = 1._r8 / lu(k,448) + lu(k,449) = lu(k,449) * lu(k,448) + lu(k,450) = lu(k,450) * lu(k,448) + lu(k,451) = lu(k,451) * lu(k,448) + lu(k,452) = lu(k,452) * lu(k,448) + lu(k,453) = lu(k,453) * lu(k,448) + lu(k,454) = lu(k,454) * lu(k,448) + lu(k,455) = lu(k,455) * lu(k,448) + lu(k,456) = lu(k,456) * lu(k,448) + lu(k,820) = lu(k,820) - lu(k,449) * lu(k,817) + lu(k,821) = lu(k,821) - lu(k,450) * lu(k,817) + lu(k,822) = lu(k,822) - lu(k,451) * lu(k,817) + lu(k,826) = lu(k,826) - lu(k,452) * lu(k,817) + lu(k,828) = lu(k,828) - lu(k,453) * lu(k,817) + lu(k,829) = lu(k,829) - lu(k,454) * lu(k,817) + lu(k,830) = lu(k,830) - lu(k,455) * lu(k,817) + lu(k,831) = lu(k,831) - lu(k,456) * lu(k,817) + lu(k,855) = lu(k,855) - lu(k,449) * lu(k,843) + lu(k,856) = lu(k,856) - lu(k,450) * lu(k,843) + lu(k,857) = lu(k,857) - lu(k,451) * lu(k,843) + lu(k,861) = lu(k,861) - lu(k,452) * lu(k,843) + lu(k,863) = lu(k,863) - lu(k,453) * lu(k,843) + lu(k,864) = lu(k,864) - lu(k,454) * lu(k,843) + lu(k,865) = lu(k,865) - lu(k,455) * lu(k,843) + lu(k,867) = lu(k,867) - lu(k,456) * lu(k,843) + lu(k,884) = lu(k,884) - lu(k,449) * lu(k,877) + lu(k,885) = lu(k,885) - lu(k,450) * lu(k,877) + lu(k,886) = lu(k,886) - lu(k,451) * lu(k,877) + lu(k,890) = lu(k,890) - lu(k,452) * lu(k,877) + lu(k,892) = lu(k,892) - lu(k,453) * lu(k,877) + lu(k,893) = lu(k,893) - lu(k,454) * lu(k,877) + lu(k,894) = lu(k,894) - lu(k,455) * lu(k,877) + lu(k,896) = lu(k,896) - lu(k,456) * lu(k,877) + lu(k,1042) = lu(k,1042) - lu(k,449) * lu(k,1030) + lu(k,1043) = lu(k,1043) - lu(k,450) * lu(k,1030) + lu(k,1044) = lu(k,1044) - lu(k,451) * lu(k,1030) + lu(k,1048) = lu(k,1048) - lu(k,452) * lu(k,1030) + lu(k,1050) = lu(k,1050) - lu(k,453) * lu(k,1030) + lu(k,1051) = lu(k,1051) - lu(k,454) * lu(k,1030) + lu(k,1052) = lu(k,1052) - lu(k,455) * lu(k,1030) + lu(k,1054) = lu(k,1054) - lu(k,456) * lu(k,1030) + lu(k,1164) = lu(k,1164) - lu(k,449) * lu(k,1141) + lu(k,1165) = lu(k,1165) - lu(k,450) * lu(k,1141) + lu(k,1166) = lu(k,1166) - lu(k,451) * lu(k,1141) + lu(k,1170) = lu(k,1170) - lu(k,452) * lu(k,1141) + lu(k,1172) = lu(k,1172) - lu(k,453) * lu(k,1141) + lu(k,1173) = lu(k,1173) - lu(k,454) * lu(k,1141) + lu(k,1174) = lu(k,1174) - lu(k,455) * lu(k,1141) + lu(k,1176) = lu(k,1176) - lu(k,456) * lu(k,1141) + lu(k,1233) = lu(k,1233) - lu(k,449) * lu(k,1227) + lu(k,1234) = lu(k,1234) - lu(k,450) * lu(k,1227) + lu(k,1235) = lu(k,1235) - lu(k,451) * lu(k,1227) + lu(k,1239) = lu(k,1239) - lu(k,452) * lu(k,1227) + lu(k,1241) = lu(k,1241) - lu(k,453) * lu(k,1227) + lu(k,1242) = - lu(k,454) * lu(k,1227) + lu(k,1243) = lu(k,1243) - lu(k,455) * lu(k,1227) + lu(k,1245) = lu(k,1245) - lu(k,456) * lu(k,1227) + lu(k,459) = 1._r8 / lu(k,459) + lu(k,460) = lu(k,460) * lu(k,459) + lu(k,461) = lu(k,461) * lu(k,459) + lu(k,462) = lu(k,462) * lu(k,459) + lu(k,463) = lu(k,463) * lu(k,459) + lu(k,464) = lu(k,464) * lu(k,459) + lu(k,577) = lu(k,577) - lu(k,460) * lu(k,575) + lu(k,582) = lu(k,582) - lu(k,461) * lu(k,575) + lu(k,583) = lu(k,583) - lu(k,462) * lu(k,575) + lu(k,584) = lu(k,584) - lu(k,463) * lu(k,575) + lu(k,586) = lu(k,586) - lu(k,464) * lu(k,575) + lu(k,622) = lu(k,622) - lu(k,460) * lu(k,619) + lu(k,632) = lu(k,632) - lu(k,461) * lu(k,619) + lu(k,633) = lu(k,633) - lu(k,462) * lu(k,619) + lu(k,634) = lu(k,634) - lu(k,463) * lu(k,619) + lu(k,637) = lu(k,637) - lu(k,464) * lu(k,619) + lu(k,646) = lu(k,646) - lu(k,460) * lu(k,643) + lu(k,653) = lu(k,653) - lu(k,461) * lu(k,643) + lu(k,654) = - lu(k,462) * lu(k,643) + lu(k,655) = lu(k,655) - lu(k,463) * lu(k,643) + lu(k,657) = lu(k,657) - lu(k,464) * lu(k,643) + lu(k,688) = lu(k,688) - lu(k,460) * lu(k,686) + lu(k,698) = lu(k,698) - lu(k,461) * lu(k,686) + lu(k,699) = lu(k,699) - lu(k,462) * lu(k,686) + lu(k,700) = lu(k,700) - lu(k,463) * lu(k,686) + lu(k,703) = lu(k,703) - lu(k,464) * lu(k,686) + lu(k,743) = lu(k,743) - lu(k,460) * lu(k,740) + lu(k,755) = lu(k,755) - lu(k,461) * lu(k,740) + lu(k,758) = lu(k,758) - lu(k,462) * lu(k,740) + lu(k,759) = lu(k,759) - lu(k,463) * lu(k,740) + lu(k,763) = lu(k,763) - lu(k,464) * lu(k,740) + lu(k,846) = lu(k,846) - lu(k,460) * lu(k,844) + lu(k,853) = lu(k,853) - lu(k,461) * lu(k,844) + lu(k,857) = lu(k,857) - lu(k,462) * lu(k,844) + lu(k,858) = lu(k,858) - lu(k,463) * lu(k,844) + lu(k,863) = lu(k,863) - lu(k,464) * lu(k,844) + lu(k,925) = lu(k,925) - lu(k,460) * lu(k,921) + lu(k,938) = lu(k,938) - lu(k,461) * lu(k,921) + lu(k,942) = lu(k,942) - lu(k,462) * lu(k,921) + lu(k,943) = lu(k,943) - lu(k,463) * lu(k,921) + lu(k,948) = lu(k,948) - lu(k,464) * lu(k,921) + lu(k,989) = lu(k,989) - lu(k,460) * lu(k,984) + lu(k,1004) = lu(k,1004) - lu(k,461) * lu(k,984) + lu(k,1008) = lu(k,1008) - lu(k,462) * lu(k,984) + lu(k,1009) = lu(k,1009) - lu(k,463) * lu(k,984) + lu(k,1014) = lu(k,1014) - lu(k,464) * lu(k,984) + lu(k,1147) = lu(k,1147) - lu(k,460) * lu(k,1142) + lu(k,1162) = lu(k,1162) - lu(k,461) * lu(k,1142) + lu(k,1166) = lu(k,1166) - lu(k,462) * lu(k,1142) + lu(k,1167) = lu(k,1167) - lu(k,463) * lu(k,1142) + lu(k,1172) = lu(k,1172) - lu(k,464) * lu(k,1142) + lu(k,1192) = lu(k,1192) - lu(k,460) * lu(k,1188) + lu(k,1206) = lu(k,1206) - lu(k,461) * lu(k,1188) + lu(k,1210) = lu(k,1210) - lu(k,462) * lu(k,1188) + lu(k,1211) = lu(k,1211) - lu(k,463) * lu(k,1188) + lu(k,1216) = lu(k,1216) - lu(k,464) * lu(k,1188) + lu(k,1261) = lu(k,1261) - lu(k,460) * lu(k,1257) + lu(k,1273) = lu(k,1273) - lu(k,461) * lu(k,1257) + lu(k,1277) = lu(k,1277) - lu(k,462) * lu(k,1257) + lu(k,1278) = lu(k,1278) - lu(k,463) * lu(k,1257) + lu(k,1283) = lu(k,1283) - lu(k,464) * lu(k,1257) + lu(k,467) = 1._r8 / lu(k,467) + lu(k,468) = lu(k,468) * lu(k,467) + lu(k,469) = lu(k,469) * lu(k,467) + lu(k,470) = lu(k,470) * lu(k,467) + lu(k,471) = lu(k,471) * lu(k,467) + lu(k,472) = lu(k,472) * lu(k,467) + lu(k,473) = lu(k,473) * lu(k,467) + lu(k,474) = lu(k,474) * lu(k,467) + lu(k,475) = lu(k,475) * lu(k,467) + lu(k,622) = lu(k,622) - lu(k,468) * lu(k,620) + lu(k,624) = lu(k,624) - lu(k,469) * lu(k,620) + lu(k,632) = lu(k,632) - lu(k,470) * lu(k,620) + lu(k,634) = lu(k,634) - lu(k,471) * lu(k,620) + lu(k,636) = lu(k,636) - lu(k,472) * lu(k,620) + lu(k,637) = lu(k,637) - lu(k,473) * lu(k,620) + lu(k,638) = lu(k,638) - lu(k,474) * lu(k,620) + lu(k,640) = - lu(k,475) * lu(k,620) + lu(k,646) = lu(k,646) - lu(k,468) * lu(k,644) + lu(k,647) = - lu(k,469) * lu(k,644) + lu(k,653) = lu(k,653) - lu(k,470) * lu(k,644) + lu(k,655) = lu(k,655) - lu(k,471) * lu(k,644) + lu(k,656) = lu(k,656) - lu(k,472) * lu(k,644) + lu(k,657) = lu(k,657) - lu(k,473) * lu(k,644) + lu(k,658) = lu(k,658) - lu(k,474) * lu(k,644) + lu(k,660) = - lu(k,475) * lu(k,644) + lu(k,925) = lu(k,925) - lu(k,468) * lu(k,922) + lu(k,929) = lu(k,929) - lu(k,469) * lu(k,922) + lu(k,938) = lu(k,938) - lu(k,470) * lu(k,922) + lu(k,943) = lu(k,943) - lu(k,471) * lu(k,922) + lu(k,946) = lu(k,946) - lu(k,472) * lu(k,922) + lu(k,948) = lu(k,948) - lu(k,473) * lu(k,922) + lu(k,949) = lu(k,949) - lu(k,474) * lu(k,922) + lu(k,952) = lu(k,952) - lu(k,475) * lu(k,922) + lu(k,989) = lu(k,989) - lu(k,468) * lu(k,985) + lu(k,994) = - lu(k,469) * lu(k,985) + lu(k,1004) = lu(k,1004) - lu(k,470) * lu(k,985) + lu(k,1009) = lu(k,1009) - lu(k,471) * lu(k,985) + lu(k,1012) = lu(k,1012) - lu(k,472) * lu(k,985) + lu(k,1014) = lu(k,1014) - lu(k,473) * lu(k,985) + lu(k,1015) = lu(k,1015) - lu(k,474) * lu(k,985) + lu(k,1018) = lu(k,1018) - lu(k,475) * lu(k,985) + lu(k,1147) = lu(k,1147) - lu(k,468) * lu(k,1143) + lu(k,1152) = lu(k,1152) - lu(k,469) * lu(k,1143) + lu(k,1162) = lu(k,1162) - lu(k,470) * lu(k,1143) + lu(k,1167) = lu(k,1167) - lu(k,471) * lu(k,1143) + lu(k,1170) = lu(k,1170) - lu(k,472) * lu(k,1143) + lu(k,1172) = lu(k,1172) - lu(k,473) * lu(k,1143) + lu(k,1173) = lu(k,1173) - lu(k,474) * lu(k,1143) + lu(k,1176) = lu(k,1176) - lu(k,475) * lu(k,1143) + lu(k,1192) = lu(k,1192) - lu(k,468) * lu(k,1189) + lu(k,1196) = lu(k,1196) - lu(k,469) * lu(k,1189) + lu(k,1206) = lu(k,1206) - lu(k,470) * lu(k,1189) + lu(k,1211) = lu(k,1211) - lu(k,471) * lu(k,1189) + lu(k,1214) = lu(k,1214) - lu(k,472) * lu(k,1189) + lu(k,1216) = lu(k,1216) - lu(k,473) * lu(k,1189) + lu(k,1217) = lu(k,1217) - lu(k,474) * lu(k,1189) + lu(k,1220) = lu(k,1220) - lu(k,475) * lu(k,1189) + lu(k,1261) = lu(k,1261) - lu(k,468) * lu(k,1258) + lu(k,1264) = lu(k,1264) - lu(k,469) * lu(k,1258) + lu(k,1273) = lu(k,1273) - lu(k,470) * lu(k,1258) + lu(k,1278) = lu(k,1278) - lu(k,471) * lu(k,1258) + lu(k,1281) = lu(k,1281) - lu(k,472) * lu(k,1258) + lu(k,1283) = lu(k,1283) - lu(k,473) * lu(k,1258) + lu(k,1284) = lu(k,1284) - lu(k,474) * lu(k,1258) + lu(k,1287) = lu(k,1287) - lu(k,475) * lu(k,1258) + lu(k,477) = 1._r8 / lu(k,477) + lu(k,478) = lu(k,478) * lu(k,477) + lu(k,479) = lu(k,479) * lu(k,477) + lu(k,480) = lu(k,480) * lu(k,477) + lu(k,481) = lu(k,481) * lu(k,477) + lu(k,482) = lu(k,482) * lu(k,477) + lu(k,483) = lu(k,483) * lu(k,477) + lu(k,484) = lu(k,484) * lu(k,477) + lu(k,485) = lu(k,485) * lu(k,477) + lu(k,486) = lu(k,486) * lu(k,477) + lu(k,487) = lu(k,487) * lu(k,477) + lu(k,488) = lu(k,488) * lu(k,477) + lu(k,489) = lu(k,489) * lu(k,477) + lu(k,528) = lu(k,528) - lu(k,478) * lu(k,526) + lu(k,529) = - lu(k,479) * lu(k,526) + lu(k,534) = lu(k,534) - lu(k,480) * lu(k,526) + lu(k,535) = - lu(k,481) * lu(k,526) + lu(k,536) = lu(k,536) - lu(k,482) * lu(k,526) + lu(k,537) = - lu(k,483) * lu(k,526) + lu(k,538) = - lu(k,484) * lu(k,526) + lu(k,539) = lu(k,539) - lu(k,485) * lu(k,526) + lu(k,540) = lu(k,540) - lu(k,486) * lu(k,526) + lu(k,543) = - lu(k,487) * lu(k,526) + lu(k,544) = lu(k,544) - lu(k,488) * lu(k,526) + lu(k,547) = lu(k,547) - lu(k,489) * lu(k,526) + lu(k,846) = lu(k,846) - lu(k,478) * lu(k,845) + lu(k,847) = lu(k,847) - lu(k,479) * lu(k,845) + lu(k,851) = lu(k,851) - lu(k,480) * lu(k,845) + lu(k,852) = lu(k,852) - lu(k,481) * lu(k,845) + lu(k,853) = lu(k,853) - lu(k,482) * lu(k,845) + lu(k,855) = lu(k,855) - lu(k,483) * lu(k,845) + lu(k,856) = lu(k,856) - lu(k,484) * lu(k,845) + lu(k,857) = lu(k,857) - lu(k,485) * lu(k,845) + lu(k,858) = lu(k,858) - lu(k,486) * lu(k,845) + lu(k,862) = lu(k,862) - lu(k,487) * lu(k,845) + lu(k,863) = lu(k,863) - lu(k,488) * lu(k,845) + lu(k,867) = lu(k,867) - lu(k,489) * lu(k,845) + lu(k,989) = lu(k,989) - lu(k,478) * lu(k,986) + lu(k,990) = - lu(k,479) * lu(k,986) + lu(k,1002) = lu(k,1002) - lu(k,480) * lu(k,986) + lu(k,1003) = lu(k,1003) - lu(k,481) * lu(k,986) + lu(k,1004) = lu(k,1004) - lu(k,482) * lu(k,986) + lu(k,1006) = - lu(k,483) * lu(k,986) + lu(k,1007) = lu(k,1007) - lu(k,484) * lu(k,986) + lu(k,1008) = lu(k,1008) - lu(k,485) * lu(k,986) + lu(k,1009) = lu(k,1009) - lu(k,486) * lu(k,986) + lu(k,1013) = lu(k,1013) - lu(k,487) * lu(k,986) + lu(k,1014) = lu(k,1014) - lu(k,488) * lu(k,986) + lu(k,1018) = lu(k,1018) - lu(k,489) * lu(k,986) + lu(k,1073) = - lu(k,478) * lu(k,1072) + lu(k,1074) = lu(k,1074) - lu(k,479) * lu(k,1072) + lu(k,1075) = lu(k,1075) - lu(k,480) * lu(k,1072) + lu(k,1076) = lu(k,1076) - lu(k,481) * lu(k,1072) + lu(k,1077) = lu(k,1077) - lu(k,482) * lu(k,1072) + lu(k,1079) = lu(k,1079) - lu(k,483) * lu(k,1072) + lu(k,1080) = lu(k,1080) - lu(k,484) * lu(k,1072) + lu(k,1081) = lu(k,1081) - lu(k,485) * lu(k,1072) + lu(k,1082) = lu(k,1082) - lu(k,486) * lu(k,1072) + lu(k,1086) = lu(k,1086) - lu(k,487) * lu(k,1072) + lu(k,1087) = lu(k,1087) - lu(k,488) * lu(k,1072) + lu(k,1091) = lu(k,1091) - lu(k,489) * lu(k,1072) + lu(k,1147) = lu(k,1147) - lu(k,478) * lu(k,1144) + lu(k,1148) = lu(k,1148) - lu(k,479) * lu(k,1144) + lu(k,1160) = lu(k,1160) - lu(k,480) * lu(k,1144) + lu(k,1161) = lu(k,1161) - lu(k,481) * lu(k,1144) + lu(k,1162) = lu(k,1162) - lu(k,482) * lu(k,1144) + lu(k,1164) = lu(k,1164) - lu(k,483) * lu(k,1144) + lu(k,1165) = lu(k,1165) - lu(k,484) * lu(k,1144) + lu(k,1166) = lu(k,1166) - lu(k,485) * lu(k,1144) + lu(k,1167) = lu(k,1167) - lu(k,486) * lu(k,1144) + lu(k,1171) = lu(k,1171) - lu(k,487) * lu(k,1144) + lu(k,1172) = lu(k,1172) - lu(k,488) * lu(k,1144) + lu(k,1176) = lu(k,1176) - lu(k,489) * lu(k,1144) + end do + end subroutine lu_fac11 + subroutine lu_fac12( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,492) = 1._r8 / lu(k,492) + lu(k,493) = lu(k,493) * lu(k,492) + lu(k,494) = lu(k,494) * lu(k,492) + lu(k,495) = lu(k,495) * lu(k,492) + lu(k,496) = lu(k,496) * lu(k,492) + lu(k,497) = lu(k,497) * lu(k,492) + lu(k,498) = lu(k,498) * lu(k,492) + lu(k,499) = lu(k,499) * lu(k,492) + lu(k,500) = lu(k,500) * lu(k,492) + lu(k,501) = lu(k,501) * lu(k,492) + lu(k,502) = lu(k,502) * lu(k,492) + lu(k,742) = lu(k,742) - lu(k,493) * lu(k,741) + lu(k,747) = lu(k,747) - lu(k,494) * lu(k,741) + lu(k,751) = lu(k,751) - lu(k,495) * lu(k,741) + lu(k,753) = lu(k,753) - lu(k,496) * lu(k,741) + lu(k,755) = lu(k,755) - lu(k,497) * lu(k,741) + lu(k,759) = lu(k,759) - lu(k,498) * lu(k,741) + lu(k,761) = lu(k,761) - lu(k,499) * lu(k,741) + lu(k,763) = lu(k,763) - lu(k,500) * lu(k,741) + lu(k,766) = lu(k,766) - lu(k,501) * lu(k,741) + lu(k,767) = lu(k,767) - lu(k,502) * lu(k,741) + lu(k,924) = lu(k,924) - lu(k,493) * lu(k,923) + lu(k,930) = - lu(k,494) * lu(k,923) + lu(k,934) = lu(k,934) - lu(k,495) * lu(k,923) + lu(k,936) = lu(k,936) - lu(k,496) * lu(k,923) + lu(k,938) = lu(k,938) - lu(k,497) * lu(k,923) + lu(k,943) = lu(k,943) - lu(k,498) * lu(k,923) + lu(k,946) = lu(k,946) - lu(k,499) * lu(k,923) + lu(k,948) = lu(k,948) - lu(k,500) * lu(k,923) + lu(k,951) = lu(k,951) - lu(k,501) * lu(k,923) + lu(k,952) = lu(k,952) - lu(k,502) * lu(k,923) + lu(k,988) = - lu(k,493) * lu(k,987) + lu(k,995) = lu(k,995) - lu(k,494) * lu(k,987) + lu(k,1000) = lu(k,1000) - lu(k,495) * lu(k,987) + lu(k,1002) = lu(k,1002) - lu(k,496) * lu(k,987) + lu(k,1004) = lu(k,1004) - lu(k,497) * lu(k,987) + lu(k,1009) = lu(k,1009) - lu(k,498) * lu(k,987) + lu(k,1012) = lu(k,1012) - lu(k,499) * lu(k,987) + lu(k,1014) = lu(k,1014) - lu(k,500) * lu(k,987) + lu(k,1017) = lu(k,1017) - lu(k,501) * lu(k,987) + lu(k,1018) = lu(k,1018) - lu(k,502) * lu(k,987) + lu(k,1146) = lu(k,1146) - lu(k,493) * lu(k,1145) + lu(k,1153) = lu(k,1153) - lu(k,494) * lu(k,1145) + lu(k,1158) = lu(k,1158) - lu(k,495) * lu(k,1145) + lu(k,1160) = lu(k,1160) - lu(k,496) * lu(k,1145) + lu(k,1162) = lu(k,1162) - lu(k,497) * lu(k,1145) + lu(k,1167) = lu(k,1167) - lu(k,498) * lu(k,1145) + lu(k,1170) = lu(k,1170) - lu(k,499) * lu(k,1145) + lu(k,1172) = lu(k,1172) - lu(k,500) * lu(k,1145) + lu(k,1175) = lu(k,1175) - lu(k,501) * lu(k,1145) + lu(k,1176) = lu(k,1176) - lu(k,502) * lu(k,1145) + lu(k,1191) = lu(k,1191) - lu(k,493) * lu(k,1190) + lu(k,1197) = lu(k,1197) - lu(k,494) * lu(k,1190) + lu(k,1202) = lu(k,1202) - lu(k,495) * lu(k,1190) + lu(k,1204) = lu(k,1204) - lu(k,496) * lu(k,1190) + lu(k,1206) = lu(k,1206) - lu(k,497) * lu(k,1190) + lu(k,1211) = lu(k,1211) - lu(k,498) * lu(k,1190) + lu(k,1214) = lu(k,1214) - lu(k,499) * lu(k,1190) + lu(k,1216) = lu(k,1216) - lu(k,500) * lu(k,1190) + lu(k,1219) = lu(k,1219) - lu(k,501) * lu(k,1190) + lu(k,1220) = lu(k,1220) - lu(k,502) * lu(k,1190) + lu(k,1260) = lu(k,1260) - lu(k,493) * lu(k,1259) + lu(k,1265) = lu(k,1265) - lu(k,494) * lu(k,1259) + lu(k,1269) = lu(k,1269) - lu(k,495) * lu(k,1259) + lu(k,1271) = lu(k,1271) - lu(k,496) * lu(k,1259) + lu(k,1273) = lu(k,1273) - lu(k,497) * lu(k,1259) + lu(k,1278) = lu(k,1278) - lu(k,498) * lu(k,1259) + lu(k,1281) = lu(k,1281) - lu(k,499) * lu(k,1259) + lu(k,1283) = lu(k,1283) - lu(k,500) * lu(k,1259) + lu(k,1286) = lu(k,1286) - lu(k,501) * lu(k,1259) + lu(k,1287) = lu(k,1287) - lu(k,502) * lu(k,1259) + lu(k,503) = 1._r8 / lu(k,503) + lu(k,504) = lu(k,504) * lu(k,503) + lu(k,505) = lu(k,505) * lu(k,503) + lu(k,506) = lu(k,506) * lu(k,503) + lu(k,507) = lu(k,507) * lu(k,503) + lu(k,508) = lu(k,508) * lu(k,503) + lu(k,532) = lu(k,532) - lu(k,504) * lu(k,527) + lu(k,533) = lu(k,533) - lu(k,505) * lu(k,527) + lu(k,536) = lu(k,536) - lu(k,506) * lu(k,527) + lu(k,540) = lu(k,540) - lu(k,507) * lu(k,527) + lu(k,544) = lu(k,544) - lu(k,508) * lu(k,527) + lu(k,579) = lu(k,579) - lu(k,504) * lu(k,576) + lu(k,580) = lu(k,580) - lu(k,505) * lu(k,576) + lu(k,582) = lu(k,582) - lu(k,506) * lu(k,576) + lu(k,584) = lu(k,584) - lu(k,507) * lu(k,576) + lu(k,586) = lu(k,586) - lu(k,508) * lu(k,576) + lu(k,625) = lu(k,625) - lu(k,504) * lu(k,621) + lu(k,629) = lu(k,629) - lu(k,505) * lu(k,621) + lu(k,632) = lu(k,632) - lu(k,506) * lu(k,621) + lu(k,634) = lu(k,634) - lu(k,507) * lu(k,621) + lu(k,637) = lu(k,637) - lu(k,508) * lu(k,621) + lu(k,648) = lu(k,648) - lu(k,504) * lu(k,645) + lu(k,651) = lu(k,651) - lu(k,505) * lu(k,645) + lu(k,653) = lu(k,653) - lu(k,506) * lu(k,645) + lu(k,655) = lu(k,655) - lu(k,507) * lu(k,645) + lu(k,657) = lu(k,657) - lu(k,508) * lu(k,645) + lu(k,667) = - lu(k,504) * lu(k,665) + lu(k,669) = lu(k,669) - lu(k,505) * lu(k,665) + lu(k,671) = lu(k,671) - lu(k,506) * lu(k,665) + lu(k,673) = lu(k,673) - lu(k,507) * lu(k,665) + lu(k,676) = lu(k,676) - lu(k,508) * lu(k,665) + lu(k,691) = lu(k,691) - lu(k,504) * lu(k,687) + lu(k,695) = lu(k,695) - lu(k,505) * lu(k,687) + lu(k,698) = lu(k,698) - lu(k,506) * lu(k,687) + lu(k,700) = lu(k,700) - lu(k,507) * lu(k,687) + lu(k,703) = lu(k,703) - lu(k,508) * lu(k,687) + lu(k,747) = lu(k,747) - lu(k,504) * lu(k,742) + lu(k,751) = lu(k,751) - lu(k,505) * lu(k,742) + lu(k,755) = lu(k,755) - lu(k,506) * lu(k,742) + lu(k,759) = lu(k,759) - lu(k,507) * lu(k,742) + lu(k,763) = lu(k,763) - lu(k,508) * lu(k,742) + lu(k,930) = lu(k,930) - lu(k,504) * lu(k,924) + lu(k,934) = lu(k,934) - lu(k,505) * lu(k,924) + lu(k,938) = lu(k,938) - lu(k,506) * lu(k,924) + lu(k,943) = lu(k,943) - lu(k,507) * lu(k,924) + lu(k,948) = lu(k,948) - lu(k,508) * lu(k,924) + lu(k,995) = lu(k,995) - lu(k,504) * lu(k,988) + lu(k,1000) = lu(k,1000) - lu(k,505) * lu(k,988) + lu(k,1004) = lu(k,1004) - lu(k,506) * lu(k,988) + lu(k,1009) = lu(k,1009) - lu(k,507) * lu(k,988) + lu(k,1014) = lu(k,1014) - lu(k,508) * lu(k,988) + lu(k,1033) = - lu(k,504) * lu(k,1031) + lu(k,1036) = lu(k,1036) - lu(k,505) * lu(k,1031) + lu(k,1040) = lu(k,1040) - lu(k,506) * lu(k,1031) + lu(k,1045) = lu(k,1045) - lu(k,507) * lu(k,1031) + lu(k,1050) = lu(k,1050) - lu(k,508) * lu(k,1031) + lu(k,1153) = lu(k,1153) - lu(k,504) * lu(k,1146) + lu(k,1158) = lu(k,1158) - lu(k,505) * lu(k,1146) + lu(k,1162) = lu(k,1162) - lu(k,506) * lu(k,1146) + lu(k,1167) = lu(k,1167) - lu(k,507) * lu(k,1146) + lu(k,1172) = lu(k,1172) - lu(k,508) * lu(k,1146) + lu(k,1197) = lu(k,1197) - lu(k,504) * lu(k,1191) + lu(k,1202) = lu(k,1202) - lu(k,505) * lu(k,1191) + lu(k,1206) = lu(k,1206) - lu(k,506) * lu(k,1191) + lu(k,1211) = lu(k,1211) - lu(k,507) * lu(k,1191) + lu(k,1216) = lu(k,1216) - lu(k,508) * lu(k,1191) + lu(k,1265) = lu(k,1265) - lu(k,504) * lu(k,1260) + lu(k,1269) = lu(k,1269) - lu(k,505) * lu(k,1260) + lu(k,1273) = lu(k,1273) - lu(k,506) * lu(k,1260) + lu(k,1278) = lu(k,1278) - lu(k,507) * lu(k,1260) + lu(k,1283) = lu(k,1283) - lu(k,508) * lu(k,1260) + lu(k,510) = 1._r8 / lu(k,510) + lu(k,511) = lu(k,511) * lu(k,510) + lu(k,512) = lu(k,512) * lu(k,510) + lu(k,513) = lu(k,513) * lu(k,510) + lu(k,539) = lu(k,539) - lu(k,511) * lu(k,528) + lu(k,540) = lu(k,540) - lu(k,512) * lu(k,528) + lu(k,544) = lu(k,544) - lu(k,513) * lu(k,528) + lu(k,553) = - lu(k,511) * lu(k,549) + lu(k,554) = lu(k,554) - lu(k,512) * lu(k,549) + lu(k,556) = lu(k,556) - lu(k,513) * lu(k,549) + lu(k,566) = - lu(k,511) * lu(k,559) + lu(k,567) = lu(k,567) - lu(k,512) * lu(k,559) + lu(k,569) = lu(k,569) - lu(k,513) * lu(k,559) + lu(k,583) = lu(k,583) - lu(k,511) * lu(k,577) + lu(k,584) = lu(k,584) - lu(k,512) * lu(k,577) + lu(k,586) = lu(k,586) - lu(k,513) * lu(k,577) + lu(k,593) = - lu(k,511) * lu(k,590) + lu(k,594) = lu(k,594) - lu(k,512) * lu(k,590) + lu(k,596) = lu(k,596) - lu(k,513) * lu(k,590) + lu(k,633) = lu(k,633) - lu(k,511) * lu(k,622) + lu(k,634) = lu(k,634) - lu(k,512) * lu(k,622) + lu(k,637) = lu(k,637) - lu(k,513) * lu(k,622) + lu(k,654) = lu(k,654) - lu(k,511) * lu(k,646) + lu(k,655) = lu(k,655) - lu(k,512) * lu(k,646) + lu(k,657) = lu(k,657) - lu(k,513) * lu(k,646) + lu(k,672) = lu(k,672) - lu(k,511) * lu(k,666) + lu(k,673) = lu(k,673) - lu(k,512) * lu(k,666) + lu(k,676) = lu(k,676) - lu(k,513) * lu(k,666) + lu(k,699) = lu(k,699) - lu(k,511) * lu(k,688) + lu(k,700) = lu(k,700) - lu(k,512) * lu(k,688) + lu(k,703) = lu(k,703) - lu(k,513) * lu(k,688) + lu(k,721) = lu(k,721) - lu(k,511) * lu(k,708) + lu(k,722) = lu(k,722) - lu(k,512) * lu(k,708) + lu(k,726) = lu(k,726) - lu(k,513) * lu(k,708) + lu(k,758) = lu(k,758) - lu(k,511) * lu(k,743) + lu(k,759) = lu(k,759) - lu(k,512) * lu(k,743) + lu(k,763) = lu(k,763) - lu(k,513) * lu(k,743) + lu(k,787) = lu(k,787) - lu(k,511) * lu(k,780) + lu(k,788) = lu(k,788) - lu(k,512) * lu(k,780) + lu(k,793) = lu(k,793) - lu(k,513) * lu(k,780) + lu(k,803) = lu(k,803) - lu(k,511) * lu(k,797) + lu(k,804) = lu(k,804) - lu(k,512) * lu(k,797) + lu(k,809) = lu(k,809) - lu(k,513) * lu(k,797) + lu(k,857) = lu(k,857) - lu(k,511) * lu(k,846) + lu(k,858) = lu(k,858) - lu(k,512) * lu(k,846) + lu(k,863) = lu(k,863) - lu(k,513) * lu(k,846) + lu(k,886) = lu(k,886) - lu(k,511) * lu(k,878) + lu(k,887) = lu(k,887) - lu(k,512) * lu(k,878) + lu(k,892) = lu(k,892) - lu(k,513) * lu(k,878) + lu(k,942) = lu(k,942) - lu(k,511) * lu(k,925) + lu(k,943) = lu(k,943) - lu(k,512) * lu(k,925) + lu(k,948) = lu(k,948) - lu(k,513) * lu(k,925) + lu(k,1008) = lu(k,1008) - lu(k,511) * lu(k,989) + lu(k,1009) = lu(k,1009) - lu(k,512) * lu(k,989) + lu(k,1014) = lu(k,1014) - lu(k,513) * lu(k,989) + lu(k,1044) = lu(k,1044) - lu(k,511) * lu(k,1032) + lu(k,1045) = lu(k,1045) - lu(k,512) * lu(k,1032) + lu(k,1050) = lu(k,1050) - lu(k,513) * lu(k,1032) + lu(k,1081) = lu(k,1081) - lu(k,511) * lu(k,1073) + lu(k,1082) = lu(k,1082) - lu(k,512) * lu(k,1073) + lu(k,1087) = lu(k,1087) - lu(k,513) * lu(k,1073) + lu(k,1166) = lu(k,1166) - lu(k,511) * lu(k,1147) + lu(k,1167) = lu(k,1167) - lu(k,512) * lu(k,1147) + lu(k,1172) = lu(k,1172) - lu(k,513) * lu(k,1147) + lu(k,1210) = lu(k,1210) - lu(k,511) * lu(k,1192) + lu(k,1211) = lu(k,1211) - lu(k,512) * lu(k,1192) + lu(k,1216) = lu(k,1216) - lu(k,513) * lu(k,1192) + lu(k,1277) = lu(k,1277) - lu(k,511) * lu(k,1261) + lu(k,1278) = lu(k,1278) - lu(k,512) * lu(k,1261) + lu(k,1283) = lu(k,1283) - lu(k,513) * lu(k,1261) + lu(k,514) = 1._r8 / lu(k,514) + lu(k,515) = lu(k,515) * lu(k,514) + lu(k,516) = lu(k,516) * lu(k,514) + lu(k,517) = lu(k,517) * lu(k,514) + lu(k,518) = lu(k,518) * lu(k,514) + lu(k,519) = lu(k,519) * lu(k,514) + lu(k,520) = lu(k,520) * lu(k,514) + lu(k,521) = lu(k,521) * lu(k,514) + lu(k,535) = lu(k,535) - lu(k,515) * lu(k,529) + lu(k,537) = lu(k,537) - lu(k,516) * lu(k,529) + lu(k,538) = lu(k,538) - lu(k,517) * lu(k,529) + lu(k,539) = lu(k,539) - lu(k,518) * lu(k,529) + lu(k,543) = lu(k,543) - lu(k,519) * lu(k,529) + lu(k,544) = lu(k,544) - lu(k,520) * lu(k,529) + lu(k,547) = lu(k,547) - lu(k,521) * lu(k,529) + lu(k,769) = lu(k,769) - lu(k,515) * lu(k,768) + lu(k,770) = - lu(k,516) * lu(k,768) + lu(k,771) = - lu(k,517) * lu(k,768) + lu(k,772) = lu(k,772) - lu(k,518) * lu(k,768) + lu(k,775) = - lu(k,519) * lu(k,768) + lu(k,776) = lu(k,776) - lu(k,520) * lu(k,768) + lu(k,777) = lu(k,777) - lu(k,521) * lu(k,768) + lu(k,782) = lu(k,782) - lu(k,515) * lu(k,781) + lu(k,785) = lu(k,785) - lu(k,516) * lu(k,781) + lu(k,786) = lu(k,786) - lu(k,517) * lu(k,781) + lu(k,787) = lu(k,787) - lu(k,518) * lu(k,781) + lu(k,792) = lu(k,792) - lu(k,519) * lu(k,781) + lu(k,793) = lu(k,793) - lu(k,520) * lu(k,781) + lu(k,795) = lu(k,795) - lu(k,521) * lu(k,781) + lu(k,852) = lu(k,852) - lu(k,515) * lu(k,847) + lu(k,855) = lu(k,855) - lu(k,516) * lu(k,847) + lu(k,856) = lu(k,856) - lu(k,517) * lu(k,847) + lu(k,857) = lu(k,857) - lu(k,518) * lu(k,847) + lu(k,862) = lu(k,862) - lu(k,519) * lu(k,847) + lu(k,863) = lu(k,863) - lu(k,520) * lu(k,847) + lu(k,867) = lu(k,867) - lu(k,521) * lu(k,847) + lu(k,881) = lu(k,881) - lu(k,515) * lu(k,879) + lu(k,884) = lu(k,884) - lu(k,516) * lu(k,879) + lu(k,885) = lu(k,885) - lu(k,517) * lu(k,879) + lu(k,886) = lu(k,886) - lu(k,518) * lu(k,879) + lu(k,891) = lu(k,891) - lu(k,519) * lu(k,879) + lu(k,892) = lu(k,892) - lu(k,520) * lu(k,879) + lu(k,896) = lu(k,896) - lu(k,521) * lu(k,879) + lu(k,937) = lu(k,937) - lu(k,515) * lu(k,926) + lu(k,940) = lu(k,940) - lu(k,516) * lu(k,926) + lu(k,941) = lu(k,941) - lu(k,517) * lu(k,926) + lu(k,942) = lu(k,942) - lu(k,518) * lu(k,926) + lu(k,947) = lu(k,947) - lu(k,519) * lu(k,926) + lu(k,948) = lu(k,948) - lu(k,520) * lu(k,926) + lu(k,952) = lu(k,952) - lu(k,521) * lu(k,926) + lu(k,1003) = lu(k,1003) - lu(k,515) * lu(k,990) + lu(k,1006) = lu(k,1006) - lu(k,516) * lu(k,990) + lu(k,1007) = lu(k,1007) - lu(k,517) * lu(k,990) + lu(k,1008) = lu(k,1008) - lu(k,518) * lu(k,990) + lu(k,1013) = lu(k,1013) - lu(k,519) * lu(k,990) + lu(k,1014) = lu(k,1014) - lu(k,520) * lu(k,990) + lu(k,1018) = lu(k,1018) - lu(k,521) * lu(k,990) + lu(k,1076) = lu(k,1076) - lu(k,515) * lu(k,1074) + lu(k,1079) = lu(k,1079) - lu(k,516) * lu(k,1074) + lu(k,1080) = lu(k,1080) - lu(k,517) * lu(k,1074) + lu(k,1081) = lu(k,1081) - lu(k,518) * lu(k,1074) + lu(k,1086) = lu(k,1086) - lu(k,519) * lu(k,1074) + lu(k,1087) = lu(k,1087) - lu(k,520) * lu(k,1074) + lu(k,1091) = lu(k,1091) - lu(k,521) * lu(k,1074) + lu(k,1161) = lu(k,1161) - lu(k,515) * lu(k,1148) + lu(k,1164) = lu(k,1164) - lu(k,516) * lu(k,1148) + lu(k,1165) = lu(k,1165) - lu(k,517) * lu(k,1148) + lu(k,1166) = lu(k,1166) - lu(k,518) * lu(k,1148) + lu(k,1171) = lu(k,1171) - lu(k,519) * lu(k,1148) + lu(k,1172) = lu(k,1172) - lu(k,520) * lu(k,1148) + lu(k,1176) = lu(k,1176) - lu(k,521) * lu(k,1148) + lu(k,1293) = lu(k,1293) - lu(k,515) * lu(k,1291) + lu(k,1295) = - lu(k,516) * lu(k,1291) + lu(k,1296) = - lu(k,517) * lu(k,1291) + lu(k,1297) = lu(k,1297) - lu(k,518) * lu(k,1291) + lu(k,1302) = lu(k,1302) - lu(k,519) * lu(k,1291) + lu(k,1303) = lu(k,1303) - lu(k,520) * lu(k,1291) + lu(k,1307) = lu(k,1307) - lu(k,521) * lu(k,1291) + lu(k,530) = 1._r8 / lu(k,530) + lu(k,531) = lu(k,531) * lu(k,530) + lu(k,532) = lu(k,532) * lu(k,530) + lu(k,533) = lu(k,533) * lu(k,530) + lu(k,534) = lu(k,534) * lu(k,530) + lu(k,535) = lu(k,535) * lu(k,530) + lu(k,536) = lu(k,536) * lu(k,530) + lu(k,537) = lu(k,537) * lu(k,530) + lu(k,538) = lu(k,538) * lu(k,530) + lu(k,539) = lu(k,539) * lu(k,530) + lu(k,540) = lu(k,540) * lu(k,530) + lu(k,541) = lu(k,541) * lu(k,530) + lu(k,542) = lu(k,542) * lu(k,530) + lu(k,543) = lu(k,543) * lu(k,530) + lu(k,544) = lu(k,544) * lu(k,530) + lu(k,545) = lu(k,545) * lu(k,530) + lu(k,546) = lu(k,546) * lu(k,530) + lu(k,547) = lu(k,547) * lu(k,530) + lu(k,710) = lu(k,710) - lu(k,531) * lu(k,709) + lu(k,711) = lu(k,711) - lu(k,532) * lu(k,709) + lu(k,714) = lu(k,714) - lu(k,533) * lu(k,709) + lu(k,716) = lu(k,716) - lu(k,534) * lu(k,709) + lu(k,717) = - lu(k,535) * lu(k,709) + lu(k,718) = lu(k,718) - lu(k,536) * lu(k,709) + lu(k,719) = - lu(k,537) * lu(k,709) + lu(k,720) = - lu(k,538) * lu(k,709) + lu(k,721) = lu(k,721) - lu(k,539) * lu(k,709) + lu(k,722) = lu(k,722) - lu(k,540) * lu(k,709) + lu(k,723) = lu(k,723) - lu(k,541) * lu(k,709) + lu(k,724) = - lu(k,542) * lu(k,709) + lu(k,725) = - lu(k,543) * lu(k,709) + lu(k,726) = lu(k,726) - lu(k,544) * lu(k,709) + lu(k,727) = - lu(k,545) * lu(k,709) + lu(k,728) = - lu(k,546) * lu(k,709) + lu(k,729) = - lu(k,547) * lu(k,709) + lu(k,992) = lu(k,992) - lu(k,531) * lu(k,991) + lu(k,995) = lu(k,995) - lu(k,532) * lu(k,991) + lu(k,1000) = lu(k,1000) - lu(k,533) * lu(k,991) + lu(k,1002) = lu(k,1002) - lu(k,534) * lu(k,991) + lu(k,1003) = lu(k,1003) - lu(k,535) * lu(k,991) + lu(k,1004) = lu(k,1004) - lu(k,536) * lu(k,991) + lu(k,1006) = lu(k,1006) - lu(k,537) * lu(k,991) + lu(k,1007) = lu(k,1007) - lu(k,538) * lu(k,991) + lu(k,1008) = lu(k,1008) - lu(k,539) * lu(k,991) + lu(k,1009) = lu(k,1009) - lu(k,540) * lu(k,991) + lu(k,1011) = lu(k,1011) - lu(k,541) * lu(k,991) + lu(k,1012) = lu(k,1012) - lu(k,542) * lu(k,991) + lu(k,1013) = lu(k,1013) - lu(k,543) * lu(k,991) + lu(k,1014) = lu(k,1014) - lu(k,544) * lu(k,991) + lu(k,1015) = lu(k,1015) - lu(k,545) * lu(k,991) + lu(k,1017) = lu(k,1017) - lu(k,546) * lu(k,991) + lu(k,1018) = lu(k,1018) - lu(k,547) * lu(k,991) + lu(k,1150) = lu(k,1150) - lu(k,531) * lu(k,1149) + lu(k,1153) = lu(k,1153) - lu(k,532) * lu(k,1149) + lu(k,1158) = lu(k,1158) - lu(k,533) * lu(k,1149) + lu(k,1160) = lu(k,1160) - lu(k,534) * lu(k,1149) + lu(k,1161) = lu(k,1161) - lu(k,535) * lu(k,1149) + lu(k,1162) = lu(k,1162) - lu(k,536) * lu(k,1149) + lu(k,1164) = lu(k,1164) - lu(k,537) * lu(k,1149) + lu(k,1165) = lu(k,1165) - lu(k,538) * lu(k,1149) + lu(k,1166) = lu(k,1166) - lu(k,539) * lu(k,1149) + lu(k,1167) = lu(k,1167) - lu(k,540) * lu(k,1149) + lu(k,1169) = lu(k,1169) - lu(k,541) * lu(k,1149) + lu(k,1170) = lu(k,1170) - lu(k,542) * lu(k,1149) + lu(k,1171) = lu(k,1171) - lu(k,543) * lu(k,1149) + lu(k,1172) = lu(k,1172) - lu(k,544) * lu(k,1149) + lu(k,1173) = lu(k,1173) - lu(k,545) * lu(k,1149) + lu(k,1175) = lu(k,1175) - lu(k,546) * lu(k,1149) + lu(k,1176) = lu(k,1176) - lu(k,547) * lu(k,1149) + lu(k,1194) = lu(k,1194) - lu(k,531) * lu(k,1193) + lu(k,1197) = lu(k,1197) - lu(k,532) * lu(k,1193) + lu(k,1202) = lu(k,1202) - lu(k,533) * lu(k,1193) + lu(k,1204) = lu(k,1204) - lu(k,534) * lu(k,1193) + lu(k,1205) = - lu(k,535) * lu(k,1193) + lu(k,1206) = lu(k,1206) - lu(k,536) * lu(k,1193) + lu(k,1208) = - lu(k,537) * lu(k,1193) + lu(k,1209) = - lu(k,538) * lu(k,1193) + lu(k,1210) = lu(k,1210) - lu(k,539) * lu(k,1193) + lu(k,1211) = lu(k,1211) - lu(k,540) * lu(k,1193) + lu(k,1213) = lu(k,1213) - lu(k,541) * lu(k,1193) + lu(k,1214) = lu(k,1214) - lu(k,542) * lu(k,1193) + lu(k,1215) = - lu(k,543) * lu(k,1193) + lu(k,1216) = lu(k,1216) - lu(k,544) * lu(k,1193) + lu(k,1217) = lu(k,1217) - lu(k,545) * lu(k,1193) + lu(k,1219) = lu(k,1219) - lu(k,546) * lu(k,1193) + lu(k,1220) = lu(k,1220) - lu(k,547) * lu(k,1193) + end do + end subroutine lu_fac12 + subroutine lu_fac13( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,550) = 1._r8 / lu(k,550) + lu(k,551) = lu(k,551) * lu(k,550) + lu(k,552) = lu(k,552) * lu(k,550) + lu(k,553) = lu(k,553) * lu(k,550) + lu(k,554) = lu(k,554) * lu(k,550) + lu(k,555) = lu(k,555) * lu(k,550) + lu(k,556) = lu(k,556) * lu(k,550) + lu(k,557) = lu(k,557) * lu(k,550) + lu(k,558) = lu(k,558) * lu(k,550) + lu(k,714) = lu(k,714) - lu(k,551) * lu(k,710) + lu(k,716) = lu(k,716) - lu(k,552) * lu(k,710) + lu(k,721) = lu(k,721) - lu(k,553) * lu(k,710) + lu(k,722) = lu(k,722) - lu(k,554) * lu(k,710) + lu(k,724) = lu(k,724) - lu(k,555) * lu(k,710) + lu(k,726) = lu(k,726) - lu(k,556) * lu(k,710) + lu(k,727) = lu(k,727) - lu(k,557) * lu(k,710) + lu(k,729) = lu(k,729) - lu(k,558) * lu(k,710) + lu(k,751) = lu(k,751) - lu(k,551) * lu(k,744) + lu(k,753) = lu(k,753) - lu(k,552) * lu(k,744) + lu(k,758) = lu(k,758) - lu(k,553) * lu(k,744) + lu(k,759) = lu(k,759) - lu(k,554) * lu(k,744) + lu(k,761) = lu(k,761) - lu(k,555) * lu(k,744) + lu(k,763) = lu(k,763) - lu(k,556) * lu(k,744) + lu(k,764) = - lu(k,557) * lu(k,744) + lu(k,767) = lu(k,767) - lu(k,558) * lu(k,744) + lu(k,849) = - lu(k,551) * lu(k,848) + lu(k,851) = lu(k,851) - lu(k,552) * lu(k,848) + lu(k,857) = lu(k,857) - lu(k,553) * lu(k,848) + lu(k,858) = lu(k,858) - lu(k,554) * lu(k,848) + lu(k,861) = lu(k,861) - lu(k,555) * lu(k,848) + lu(k,863) = lu(k,863) - lu(k,556) * lu(k,848) + lu(k,864) = lu(k,864) - lu(k,557) * lu(k,848) + lu(k,867) = lu(k,867) - lu(k,558) * lu(k,848) + lu(k,934) = lu(k,934) - lu(k,551) * lu(k,927) + lu(k,936) = lu(k,936) - lu(k,552) * lu(k,927) + lu(k,942) = lu(k,942) - lu(k,553) * lu(k,927) + lu(k,943) = lu(k,943) - lu(k,554) * lu(k,927) + lu(k,946) = lu(k,946) - lu(k,555) * lu(k,927) + lu(k,948) = lu(k,948) - lu(k,556) * lu(k,927) + lu(k,949) = lu(k,949) - lu(k,557) * lu(k,927) + lu(k,952) = lu(k,952) - lu(k,558) * lu(k,927) + lu(k,1000) = lu(k,1000) - lu(k,551) * lu(k,992) + lu(k,1002) = lu(k,1002) - lu(k,552) * lu(k,992) + lu(k,1008) = lu(k,1008) - lu(k,553) * lu(k,992) + lu(k,1009) = lu(k,1009) - lu(k,554) * lu(k,992) + lu(k,1012) = lu(k,1012) - lu(k,555) * lu(k,992) + lu(k,1014) = lu(k,1014) - lu(k,556) * lu(k,992) + lu(k,1015) = lu(k,1015) - lu(k,557) * lu(k,992) + lu(k,1018) = lu(k,1018) - lu(k,558) * lu(k,992) + lu(k,1158) = lu(k,1158) - lu(k,551) * lu(k,1150) + lu(k,1160) = lu(k,1160) - lu(k,552) * lu(k,1150) + lu(k,1166) = lu(k,1166) - lu(k,553) * lu(k,1150) + lu(k,1167) = lu(k,1167) - lu(k,554) * lu(k,1150) + lu(k,1170) = lu(k,1170) - lu(k,555) * lu(k,1150) + lu(k,1172) = lu(k,1172) - lu(k,556) * lu(k,1150) + lu(k,1173) = lu(k,1173) - lu(k,557) * lu(k,1150) + lu(k,1176) = lu(k,1176) - lu(k,558) * lu(k,1150) + lu(k,1202) = lu(k,1202) - lu(k,551) * lu(k,1194) + lu(k,1204) = lu(k,1204) - lu(k,552) * lu(k,1194) + lu(k,1210) = lu(k,1210) - lu(k,553) * lu(k,1194) + lu(k,1211) = lu(k,1211) - lu(k,554) * lu(k,1194) + lu(k,1214) = lu(k,1214) - lu(k,555) * lu(k,1194) + lu(k,1216) = lu(k,1216) - lu(k,556) * lu(k,1194) + lu(k,1217) = lu(k,1217) - lu(k,557) * lu(k,1194) + lu(k,1220) = lu(k,1220) - lu(k,558) * lu(k,1194) + lu(k,1269) = lu(k,1269) - lu(k,551) * lu(k,1262) + lu(k,1271) = lu(k,1271) - lu(k,552) * lu(k,1262) + lu(k,1277) = lu(k,1277) - lu(k,553) * lu(k,1262) + lu(k,1278) = lu(k,1278) - lu(k,554) * lu(k,1262) + lu(k,1281) = lu(k,1281) - lu(k,555) * lu(k,1262) + lu(k,1283) = lu(k,1283) - lu(k,556) * lu(k,1262) + lu(k,1284) = lu(k,1284) - lu(k,557) * lu(k,1262) + lu(k,1287) = lu(k,1287) - lu(k,558) * lu(k,1262) + lu(k,560) = 1._r8 / lu(k,560) + lu(k,561) = lu(k,561) * lu(k,560) + lu(k,562) = lu(k,562) * lu(k,560) + lu(k,563) = lu(k,563) * lu(k,560) + lu(k,564) = lu(k,564) * lu(k,560) + lu(k,565) = lu(k,565) * lu(k,560) + lu(k,566) = lu(k,566) * lu(k,560) + lu(k,567) = lu(k,567) * lu(k,560) + lu(k,568) = lu(k,568) * lu(k,560) + lu(k,569) = lu(k,569) * lu(k,560) + lu(k,570) = lu(k,570) * lu(k,560) + lu(k,625) = lu(k,625) - lu(k,561) * lu(k,623) + lu(k,627) = - lu(k,562) * lu(k,623) + lu(k,628) = - lu(k,563) * lu(k,623) + lu(k,629) = lu(k,629) - lu(k,564) * lu(k,623) + lu(k,632) = lu(k,632) - lu(k,565) * lu(k,623) + lu(k,633) = lu(k,633) - lu(k,566) * lu(k,623) + lu(k,634) = lu(k,634) - lu(k,567) * lu(k,623) + lu(k,635) = - lu(k,568) * lu(k,623) + lu(k,637) = lu(k,637) - lu(k,569) * lu(k,623) + lu(k,640) = lu(k,640) - lu(k,570) * lu(k,623) + lu(k,691) = lu(k,691) - lu(k,561) * lu(k,689) + lu(k,693) = lu(k,693) - lu(k,562) * lu(k,689) + lu(k,694) = lu(k,694) - lu(k,563) * lu(k,689) + lu(k,695) = lu(k,695) - lu(k,564) * lu(k,689) + lu(k,698) = lu(k,698) - lu(k,565) * lu(k,689) + lu(k,699) = lu(k,699) - lu(k,566) * lu(k,689) + lu(k,700) = lu(k,700) - lu(k,567) * lu(k,689) + lu(k,701) = lu(k,701) - lu(k,568) * lu(k,689) + lu(k,703) = lu(k,703) - lu(k,569) * lu(k,689) + lu(k,706) = lu(k,706) - lu(k,570) * lu(k,689) + lu(k,747) = lu(k,747) - lu(k,561) * lu(k,745) + lu(k,749) = lu(k,749) - lu(k,562) * lu(k,745) + lu(k,750) = lu(k,750) - lu(k,563) * lu(k,745) + lu(k,751) = lu(k,751) - lu(k,564) * lu(k,745) + lu(k,755) = lu(k,755) - lu(k,565) * lu(k,745) + lu(k,758) = lu(k,758) - lu(k,566) * lu(k,745) + lu(k,759) = lu(k,759) - lu(k,567) * lu(k,745) + lu(k,760) = - lu(k,568) * lu(k,745) + lu(k,763) = lu(k,763) - lu(k,569) * lu(k,745) + lu(k,767) = lu(k,767) - lu(k,570) * lu(k,745) + lu(k,930) = lu(k,930) - lu(k,561) * lu(k,928) + lu(k,932) = lu(k,932) - lu(k,562) * lu(k,928) + lu(k,933) = lu(k,933) - lu(k,563) * lu(k,928) + lu(k,934) = lu(k,934) - lu(k,564) * lu(k,928) + lu(k,938) = lu(k,938) - lu(k,565) * lu(k,928) + lu(k,942) = lu(k,942) - lu(k,566) * lu(k,928) + lu(k,943) = lu(k,943) - lu(k,567) * lu(k,928) + lu(k,945) = lu(k,945) - lu(k,568) * lu(k,928) + lu(k,948) = lu(k,948) - lu(k,569) * lu(k,928) + lu(k,952) = lu(k,952) - lu(k,570) * lu(k,928) + lu(k,995) = lu(k,995) - lu(k,561) * lu(k,993) + lu(k,998) = - lu(k,562) * lu(k,993) + lu(k,999) = - lu(k,563) * lu(k,993) + lu(k,1000) = lu(k,1000) - lu(k,564) * lu(k,993) + lu(k,1004) = lu(k,1004) - lu(k,565) * lu(k,993) + lu(k,1008) = lu(k,1008) - lu(k,566) * lu(k,993) + lu(k,1009) = lu(k,1009) - lu(k,567) * lu(k,993) + lu(k,1011) = lu(k,1011) - lu(k,568) * lu(k,993) + lu(k,1014) = lu(k,1014) - lu(k,569) * lu(k,993) + lu(k,1018) = lu(k,1018) - lu(k,570) * lu(k,993) + lu(k,1153) = lu(k,1153) - lu(k,561) * lu(k,1151) + lu(k,1156) = lu(k,1156) - lu(k,562) * lu(k,1151) + lu(k,1157) = lu(k,1157) - lu(k,563) * lu(k,1151) + lu(k,1158) = lu(k,1158) - lu(k,564) * lu(k,1151) + lu(k,1162) = lu(k,1162) - lu(k,565) * lu(k,1151) + lu(k,1166) = lu(k,1166) - lu(k,566) * lu(k,1151) + lu(k,1167) = lu(k,1167) - lu(k,567) * lu(k,1151) + lu(k,1169) = lu(k,1169) - lu(k,568) * lu(k,1151) + lu(k,1172) = lu(k,1172) - lu(k,569) * lu(k,1151) + lu(k,1176) = lu(k,1176) - lu(k,570) * lu(k,1151) + lu(k,1197) = lu(k,1197) - lu(k,561) * lu(k,1195) + lu(k,1200) = lu(k,1200) - lu(k,562) * lu(k,1195) + lu(k,1201) = lu(k,1201) - lu(k,563) * lu(k,1195) + lu(k,1202) = lu(k,1202) - lu(k,564) * lu(k,1195) + lu(k,1206) = lu(k,1206) - lu(k,565) * lu(k,1195) + lu(k,1210) = lu(k,1210) - lu(k,566) * lu(k,1195) + lu(k,1211) = lu(k,1211) - lu(k,567) * lu(k,1195) + lu(k,1213) = lu(k,1213) - lu(k,568) * lu(k,1195) + lu(k,1216) = lu(k,1216) - lu(k,569) * lu(k,1195) + lu(k,1220) = lu(k,1220) - lu(k,570) * lu(k,1195) + lu(k,1265) = lu(k,1265) - lu(k,561) * lu(k,1263) + lu(k,1267) = lu(k,1267) - lu(k,562) * lu(k,1263) + lu(k,1268) = lu(k,1268) - lu(k,563) * lu(k,1263) + lu(k,1269) = lu(k,1269) - lu(k,564) * lu(k,1263) + lu(k,1273) = lu(k,1273) - lu(k,565) * lu(k,1263) + lu(k,1277) = lu(k,1277) - lu(k,566) * lu(k,1263) + lu(k,1278) = lu(k,1278) - lu(k,567) * lu(k,1263) + lu(k,1280) = lu(k,1280) - lu(k,568) * lu(k,1263) + lu(k,1283) = lu(k,1283) - lu(k,569) * lu(k,1263) + lu(k,1287) = lu(k,1287) - lu(k,570) * lu(k,1263) + lu(k,578) = 1._r8 / lu(k,578) + lu(k,579) = lu(k,579) * lu(k,578) + lu(k,580) = lu(k,580) * lu(k,578) + lu(k,581) = lu(k,581) * lu(k,578) + lu(k,582) = lu(k,582) * lu(k,578) + lu(k,583) = lu(k,583) * lu(k,578) + lu(k,584) = lu(k,584) * lu(k,578) + lu(k,585) = lu(k,585) * lu(k,578) + lu(k,586) = lu(k,586) * lu(k,578) + lu(k,587) = lu(k,587) * lu(k,578) + lu(k,588) = lu(k,588) * lu(k,578) + lu(k,625) = lu(k,625) - lu(k,579) * lu(k,624) + lu(k,629) = lu(k,629) - lu(k,580) * lu(k,624) + lu(k,631) = lu(k,631) - lu(k,581) * lu(k,624) + lu(k,632) = lu(k,632) - lu(k,582) * lu(k,624) + lu(k,633) = lu(k,633) - lu(k,583) * lu(k,624) + lu(k,634) = lu(k,634) - lu(k,584) * lu(k,624) + lu(k,636) = lu(k,636) - lu(k,585) * lu(k,624) + lu(k,637) = lu(k,637) - lu(k,586) * lu(k,624) + lu(k,638) = lu(k,638) - lu(k,587) * lu(k,624) + lu(k,639) = lu(k,639) - lu(k,588) * lu(k,624) + lu(k,648) = lu(k,648) - lu(k,579) * lu(k,647) + lu(k,651) = lu(k,651) - lu(k,580) * lu(k,647) + lu(k,652) = lu(k,652) - lu(k,581) * lu(k,647) + lu(k,653) = lu(k,653) - lu(k,582) * lu(k,647) + lu(k,654) = lu(k,654) - lu(k,583) * lu(k,647) + lu(k,655) = lu(k,655) - lu(k,584) * lu(k,647) + lu(k,656) = lu(k,656) - lu(k,585) * lu(k,647) + lu(k,657) = lu(k,657) - lu(k,586) * lu(k,647) + lu(k,658) = lu(k,658) - lu(k,587) * lu(k,647) + lu(k,659) = lu(k,659) - lu(k,588) * lu(k,647) + lu(k,691) = lu(k,691) - lu(k,579) * lu(k,690) + lu(k,695) = lu(k,695) - lu(k,580) * lu(k,690) + lu(k,697) = lu(k,697) - lu(k,581) * lu(k,690) + lu(k,698) = lu(k,698) - lu(k,582) * lu(k,690) + lu(k,699) = lu(k,699) - lu(k,583) * lu(k,690) + lu(k,700) = lu(k,700) - lu(k,584) * lu(k,690) + lu(k,702) = lu(k,702) - lu(k,585) * lu(k,690) + lu(k,703) = lu(k,703) - lu(k,586) * lu(k,690) + lu(k,704) = lu(k,704) - lu(k,587) * lu(k,690) + lu(k,705) = lu(k,705) - lu(k,588) * lu(k,690) + lu(k,747) = lu(k,747) - lu(k,579) * lu(k,746) + lu(k,751) = lu(k,751) - lu(k,580) * lu(k,746) + lu(k,753) = lu(k,753) - lu(k,581) * lu(k,746) + lu(k,755) = lu(k,755) - lu(k,582) * lu(k,746) + lu(k,758) = lu(k,758) - lu(k,583) * lu(k,746) + lu(k,759) = lu(k,759) - lu(k,584) * lu(k,746) + lu(k,761) = lu(k,761) - lu(k,585) * lu(k,746) + lu(k,763) = lu(k,763) - lu(k,586) * lu(k,746) + lu(k,764) = lu(k,764) - lu(k,587) * lu(k,746) + lu(k,766) = lu(k,766) - lu(k,588) * lu(k,746) + lu(k,930) = lu(k,930) - lu(k,579) * lu(k,929) + lu(k,934) = lu(k,934) - lu(k,580) * lu(k,929) + lu(k,936) = lu(k,936) - lu(k,581) * lu(k,929) + lu(k,938) = lu(k,938) - lu(k,582) * lu(k,929) + lu(k,942) = lu(k,942) - lu(k,583) * lu(k,929) + lu(k,943) = lu(k,943) - lu(k,584) * lu(k,929) + lu(k,946) = lu(k,946) - lu(k,585) * lu(k,929) + lu(k,948) = lu(k,948) - lu(k,586) * lu(k,929) + lu(k,949) = lu(k,949) - lu(k,587) * lu(k,929) + lu(k,951) = lu(k,951) - lu(k,588) * lu(k,929) + lu(k,995) = lu(k,995) - lu(k,579) * lu(k,994) + lu(k,1000) = lu(k,1000) - lu(k,580) * lu(k,994) + lu(k,1002) = lu(k,1002) - lu(k,581) * lu(k,994) + lu(k,1004) = lu(k,1004) - lu(k,582) * lu(k,994) + lu(k,1008) = lu(k,1008) - lu(k,583) * lu(k,994) + lu(k,1009) = lu(k,1009) - lu(k,584) * lu(k,994) + lu(k,1012) = lu(k,1012) - lu(k,585) * lu(k,994) + lu(k,1014) = lu(k,1014) - lu(k,586) * lu(k,994) + lu(k,1015) = lu(k,1015) - lu(k,587) * lu(k,994) + lu(k,1017) = lu(k,1017) - lu(k,588) * lu(k,994) + lu(k,1153) = lu(k,1153) - lu(k,579) * lu(k,1152) + lu(k,1158) = lu(k,1158) - lu(k,580) * lu(k,1152) + lu(k,1160) = lu(k,1160) - lu(k,581) * lu(k,1152) + lu(k,1162) = lu(k,1162) - lu(k,582) * lu(k,1152) + lu(k,1166) = lu(k,1166) - lu(k,583) * lu(k,1152) + lu(k,1167) = lu(k,1167) - lu(k,584) * lu(k,1152) + lu(k,1170) = lu(k,1170) - lu(k,585) * lu(k,1152) + lu(k,1172) = lu(k,1172) - lu(k,586) * lu(k,1152) + lu(k,1173) = lu(k,1173) - lu(k,587) * lu(k,1152) + lu(k,1175) = lu(k,1175) - lu(k,588) * lu(k,1152) + lu(k,1197) = lu(k,1197) - lu(k,579) * lu(k,1196) + lu(k,1202) = lu(k,1202) - lu(k,580) * lu(k,1196) + lu(k,1204) = lu(k,1204) - lu(k,581) * lu(k,1196) + lu(k,1206) = lu(k,1206) - lu(k,582) * lu(k,1196) + lu(k,1210) = lu(k,1210) - lu(k,583) * lu(k,1196) + lu(k,1211) = lu(k,1211) - lu(k,584) * lu(k,1196) + lu(k,1214) = lu(k,1214) - lu(k,585) * lu(k,1196) + lu(k,1216) = lu(k,1216) - lu(k,586) * lu(k,1196) + lu(k,1217) = lu(k,1217) - lu(k,587) * lu(k,1196) + lu(k,1219) = lu(k,1219) - lu(k,588) * lu(k,1196) + lu(k,1265) = lu(k,1265) - lu(k,579) * lu(k,1264) + lu(k,1269) = lu(k,1269) - lu(k,580) * lu(k,1264) + lu(k,1271) = lu(k,1271) - lu(k,581) * lu(k,1264) + lu(k,1273) = lu(k,1273) - lu(k,582) * lu(k,1264) + lu(k,1277) = lu(k,1277) - lu(k,583) * lu(k,1264) + lu(k,1278) = lu(k,1278) - lu(k,584) * lu(k,1264) + lu(k,1281) = lu(k,1281) - lu(k,585) * lu(k,1264) + lu(k,1283) = lu(k,1283) - lu(k,586) * lu(k,1264) + lu(k,1284) = lu(k,1284) - lu(k,587) * lu(k,1264) + lu(k,1286) = lu(k,1286) - lu(k,588) * lu(k,1264) + lu(k,591) = 1._r8 / lu(k,591) + lu(k,592) = lu(k,592) * lu(k,591) + lu(k,593) = lu(k,593) * lu(k,591) + lu(k,594) = lu(k,594) * lu(k,591) + lu(k,595) = lu(k,595) * lu(k,591) + lu(k,596) = lu(k,596) * lu(k,591) + lu(k,597) = lu(k,597) * lu(k,591) + lu(k,598) = lu(k,598) * lu(k,591) + lu(k,629) = lu(k,629) - lu(k,592) * lu(k,625) + lu(k,633) = lu(k,633) - lu(k,593) * lu(k,625) + lu(k,634) = lu(k,634) - lu(k,594) * lu(k,625) + lu(k,636) = lu(k,636) - lu(k,595) * lu(k,625) + lu(k,637) = lu(k,637) - lu(k,596) * lu(k,625) + lu(k,638) = lu(k,638) - lu(k,597) * lu(k,625) + lu(k,640) = lu(k,640) - lu(k,598) * lu(k,625) + lu(k,651) = lu(k,651) - lu(k,592) * lu(k,648) + lu(k,654) = lu(k,654) - lu(k,593) * lu(k,648) + lu(k,655) = lu(k,655) - lu(k,594) * lu(k,648) + lu(k,656) = lu(k,656) - lu(k,595) * lu(k,648) + lu(k,657) = lu(k,657) - lu(k,596) * lu(k,648) + lu(k,658) = lu(k,658) - lu(k,597) * lu(k,648) + lu(k,660) = lu(k,660) - lu(k,598) * lu(k,648) + lu(k,669) = lu(k,669) - lu(k,592) * lu(k,667) + lu(k,672) = lu(k,672) - lu(k,593) * lu(k,667) + lu(k,673) = lu(k,673) - lu(k,594) * lu(k,667) + lu(k,675) = lu(k,675) - lu(k,595) * lu(k,667) + lu(k,676) = lu(k,676) - lu(k,596) * lu(k,667) + lu(k,677) = lu(k,677) - lu(k,597) * lu(k,667) + lu(k,679) = lu(k,679) - lu(k,598) * lu(k,667) + lu(k,695) = lu(k,695) - lu(k,592) * lu(k,691) + lu(k,699) = lu(k,699) - lu(k,593) * lu(k,691) + lu(k,700) = lu(k,700) - lu(k,594) * lu(k,691) + lu(k,702) = lu(k,702) - lu(k,595) * lu(k,691) + lu(k,703) = lu(k,703) - lu(k,596) * lu(k,691) + lu(k,704) = lu(k,704) - lu(k,597) * lu(k,691) + lu(k,706) = lu(k,706) - lu(k,598) * lu(k,691) + lu(k,714) = lu(k,714) - lu(k,592) * lu(k,711) + lu(k,721) = lu(k,721) - lu(k,593) * lu(k,711) + lu(k,722) = lu(k,722) - lu(k,594) * lu(k,711) + lu(k,724) = lu(k,724) - lu(k,595) * lu(k,711) + lu(k,726) = lu(k,726) - lu(k,596) * lu(k,711) + lu(k,727) = lu(k,727) - lu(k,597) * lu(k,711) + lu(k,729) = lu(k,729) - lu(k,598) * lu(k,711) + lu(k,751) = lu(k,751) - lu(k,592) * lu(k,747) + lu(k,758) = lu(k,758) - lu(k,593) * lu(k,747) + lu(k,759) = lu(k,759) - lu(k,594) * lu(k,747) + lu(k,761) = lu(k,761) - lu(k,595) * lu(k,747) + lu(k,763) = lu(k,763) - lu(k,596) * lu(k,747) + lu(k,764) = lu(k,764) - lu(k,597) * lu(k,747) + lu(k,767) = lu(k,767) - lu(k,598) * lu(k,747) + lu(k,934) = lu(k,934) - lu(k,592) * lu(k,930) + lu(k,942) = lu(k,942) - lu(k,593) * lu(k,930) + lu(k,943) = lu(k,943) - lu(k,594) * lu(k,930) + lu(k,946) = lu(k,946) - lu(k,595) * lu(k,930) + lu(k,948) = lu(k,948) - lu(k,596) * lu(k,930) + lu(k,949) = lu(k,949) - lu(k,597) * lu(k,930) + lu(k,952) = lu(k,952) - lu(k,598) * lu(k,930) + lu(k,1000) = lu(k,1000) - lu(k,592) * lu(k,995) + lu(k,1008) = lu(k,1008) - lu(k,593) * lu(k,995) + lu(k,1009) = lu(k,1009) - lu(k,594) * lu(k,995) + lu(k,1012) = lu(k,1012) - lu(k,595) * lu(k,995) + lu(k,1014) = lu(k,1014) - lu(k,596) * lu(k,995) + lu(k,1015) = lu(k,1015) - lu(k,597) * lu(k,995) + lu(k,1018) = lu(k,1018) - lu(k,598) * lu(k,995) + lu(k,1036) = lu(k,1036) - lu(k,592) * lu(k,1033) + lu(k,1044) = lu(k,1044) - lu(k,593) * lu(k,1033) + lu(k,1045) = lu(k,1045) - lu(k,594) * lu(k,1033) + lu(k,1048) = lu(k,1048) - lu(k,595) * lu(k,1033) + lu(k,1050) = lu(k,1050) - lu(k,596) * lu(k,1033) + lu(k,1051) = lu(k,1051) - lu(k,597) * lu(k,1033) + lu(k,1054) = lu(k,1054) - lu(k,598) * lu(k,1033) + lu(k,1158) = lu(k,1158) - lu(k,592) * lu(k,1153) + lu(k,1166) = lu(k,1166) - lu(k,593) * lu(k,1153) + lu(k,1167) = lu(k,1167) - lu(k,594) * lu(k,1153) + lu(k,1170) = lu(k,1170) - lu(k,595) * lu(k,1153) + lu(k,1172) = lu(k,1172) - lu(k,596) * lu(k,1153) + lu(k,1173) = lu(k,1173) - lu(k,597) * lu(k,1153) + lu(k,1176) = lu(k,1176) - lu(k,598) * lu(k,1153) + lu(k,1202) = lu(k,1202) - lu(k,592) * lu(k,1197) + lu(k,1210) = lu(k,1210) - lu(k,593) * lu(k,1197) + lu(k,1211) = lu(k,1211) - lu(k,594) * lu(k,1197) + lu(k,1214) = lu(k,1214) - lu(k,595) * lu(k,1197) + lu(k,1216) = lu(k,1216) - lu(k,596) * lu(k,1197) + lu(k,1217) = lu(k,1217) - lu(k,597) * lu(k,1197) + lu(k,1220) = lu(k,1220) - lu(k,598) * lu(k,1197) + lu(k,1269) = lu(k,1269) - lu(k,592) * lu(k,1265) + lu(k,1277) = lu(k,1277) - lu(k,593) * lu(k,1265) + lu(k,1278) = lu(k,1278) - lu(k,594) * lu(k,1265) + lu(k,1281) = lu(k,1281) - lu(k,595) * lu(k,1265) + lu(k,1283) = lu(k,1283) - lu(k,596) * lu(k,1265) + lu(k,1284) = lu(k,1284) - lu(k,597) * lu(k,1265) + lu(k,1287) = lu(k,1287) - lu(k,598) * lu(k,1265) + lu(k,602) = 1._r8 / lu(k,602) + lu(k,603) = lu(k,603) * lu(k,602) + lu(k,604) = lu(k,604) * lu(k,602) + lu(k,605) = lu(k,605) * lu(k,602) + lu(k,606) = lu(k,606) * lu(k,602) + lu(k,607) = lu(k,607) * lu(k,602) + lu(k,608) = lu(k,608) * lu(k,602) + lu(k,609) = lu(k,609) * lu(k,602) + lu(k,610) = lu(k,610) * lu(k,602) + lu(k,611) = lu(k,611) * lu(k,602) + lu(k,612) = lu(k,612) * lu(k,602) + lu(k,613) = lu(k,613) * lu(k,602) + lu(k,614) = lu(k,614) * lu(k,602) + lu(k,881) = lu(k,881) - lu(k,603) * lu(k,880) + lu(k,883) = lu(k,883) - lu(k,604) * lu(k,880) + lu(k,885) = lu(k,885) - lu(k,605) * lu(k,880) + lu(k,886) = lu(k,886) - lu(k,606) * lu(k,880) + lu(k,887) = lu(k,887) - lu(k,607) * lu(k,880) + lu(k,888) = lu(k,888) - lu(k,608) * lu(k,880) + lu(k,889) = lu(k,889) - lu(k,609) * lu(k,880) + lu(k,890) = lu(k,890) - lu(k,610) * lu(k,880) + lu(k,892) = lu(k,892) - lu(k,611) * lu(k,880) + lu(k,894) = lu(k,894) - lu(k,612) * lu(k,880) + lu(k,895) = lu(k,895) - lu(k,613) * lu(k,880) + lu(k,896) = lu(k,896) - lu(k,614) * lu(k,880) + lu(k,960) = - lu(k,603) * lu(k,959) + lu(k,961) = lu(k,961) - lu(k,604) * lu(k,959) + lu(k,963) = lu(k,963) - lu(k,605) * lu(k,959) + lu(k,964) = lu(k,964) - lu(k,606) * lu(k,959) + lu(k,965) = lu(k,965) - lu(k,607) * lu(k,959) + lu(k,966) = lu(k,966) - lu(k,608) * lu(k,959) + lu(k,967) = - lu(k,609) * lu(k,959) + lu(k,968) = lu(k,968) - lu(k,610) * lu(k,959) + lu(k,970) = lu(k,970) - lu(k,611) * lu(k,959) + lu(k,972) = lu(k,972) - lu(k,612) * lu(k,959) + lu(k,973) = lu(k,973) - lu(k,613) * lu(k,959) + lu(k,974) = lu(k,974) - lu(k,614) * lu(k,959) + lu(k,1003) = lu(k,1003) - lu(k,603) * lu(k,996) + lu(k,1005) = lu(k,1005) - lu(k,604) * lu(k,996) + lu(k,1007) = lu(k,1007) - lu(k,605) * lu(k,996) + lu(k,1008) = lu(k,1008) - lu(k,606) * lu(k,996) + lu(k,1009) = lu(k,1009) - lu(k,607) * lu(k,996) + lu(k,1010) = lu(k,1010) - lu(k,608) * lu(k,996) + lu(k,1011) = lu(k,1011) - lu(k,609) * lu(k,996) + lu(k,1012) = lu(k,1012) - lu(k,610) * lu(k,996) + lu(k,1014) = lu(k,1014) - lu(k,611) * lu(k,996) + lu(k,1016) = lu(k,1016) - lu(k,612) * lu(k,996) + lu(k,1017) = lu(k,1017) - lu(k,613) * lu(k,996) + lu(k,1018) = lu(k,1018) - lu(k,614) * lu(k,996) + lu(k,1039) = lu(k,1039) - lu(k,603) * lu(k,1034) + lu(k,1041) = lu(k,1041) - lu(k,604) * lu(k,1034) + lu(k,1043) = lu(k,1043) - lu(k,605) * lu(k,1034) + lu(k,1044) = lu(k,1044) - lu(k,606) * lu(k,1034) + lu(k,1045) = lu(k,1045) - lu(k,607) * lu(k,1034) + lu(k,1046) = lu(k,1046) - lu(k,608) * lu(k,1034) + lu(k,1047) = lu(k,1047) - lu(k,609) * lu(k,1034) + lu(k,1048) = lu(k,1048) - lu(k,610) * lu(k,1034) + lu(k,1050) = lu(k,1050) - lu(k,611) * lu(k,1034) + lu(k,1052) = lu(k,1052) - lu(k,612) * lu(k,1034) + lu(k,1053) = lu(k,1053) - lu(k,613) * lu(k,1034) + lu(k,1054) = lu(k,1054) - lu(k,614) * lu(k,1034) + lu(k,1161) = lu(k,1161) - lu(k,603) * lu(k,1154) + lu(k,1163) = lu(k,1163) - lu(k,604) * lu(k,1154) + lu(k,1165) = lu(k,1165) - lu(k,605) * lu(k,1154) + lu(k,1166) = lu(k,1166) - lu(k,606) * lu(k,1154) + lu(k,1167) = lu(k,1167) - lu(k,607) * lu(k,1154) + lu(k,1168) = lu(k,1168) - lu(k,608) * lu(k,1154) + lu(k,1169) = lu(k,1169) - lu(k,609) * lu(k,1154) + lu(k,1170) = lu(k,1170) - lu(k,610) * lu(k,1154) + lu(k,1172) = lu(k,1172) - lu(k,611) * lu(k,1154) + lu(k,1174) = lu(k,1174) - lu(k,612) * lu(k,1154) + lu(k,1175) = lu(k,1175) - lu(k,613) * lu(k,1154) + lu(k,1176) = lu(k,1176) - lu(k,614) * lu(k,1154) + lu(k,1205) = lu(k,1205) - lu(k,603) * lu(k,1198) + lu(k,1207) = - lu(k,604) * lu(k,1198) + lu(k,1209) = lu(k,1209) - lu(k,605) * lu(k,1198) + lu(k,1210) = lu(k,1210) - lu(k,606) * lu(k,1198) + lu(k,1211) = lu(k,1211) - lu(k,607) * lu(k,1198) + lu(k,1212) = - lu(k,608) * lu(k,1198) + lu(k,1213) = lu(k,1213) - lu(k,609) * lu(k,1198) + lu(k,1214) = lu(k,1214) - lu(k,610) * lu(k,1198) + lu(k,1216) = lu(k,1216) - lu(k,611) * lu(k,1198) + lu(k,1218) = - lu(k,612) * lu(k,1198) + lu(k,1219) = lu(k,1219) - lu(k,613) * lu(k,1198) + lu(k,1220) = lu(k,1220) - lu(k,614) * lu(k,1198) + lu(k,1230) = - lu(k,603) * lu(k,1228) + lu(k,1232) = lu(k,1232) - lu(k,604) * lu(k,1228) + lu(k,1234) = lu(k,1234) - lu(k,605) * lu(k,1228) + lu(k,1235) = lu(k,1235) - lu(k,606) * lu(k,1228) + lu(k,1236) = lu(k,1236) - lu(k,607) * lu(k,1228) + lu(k,1237) = lu(k,1237) - lu(k,608) * lu(k,1228) + lu(k,1238) = - lu(k,609) * lu(k,1228) + lu(k,1239) = lu(k,1239) - lu(k,610) * lu(k,1228) + lu(k,1241) = lu(k,1241) - lu(k,611) * lu(k,1228) + lu(k,1243) = lu(k,1243) - lu(k,612) * lu(k,1228) + lu(k,1244) = lu(k,1244) - lu(k,613) * lu(k,1228) + lu(k,1245) = lu(k,1245) - lu(k,614) * lu(k,1228) + lu(k,1293) = lu(k,1293) - lu(k,603) * lu(k,1292) + lu(k,1294) = - lu(k,604) * lu(k,1292) + lu(k,1296) = lu(k,1296) - lu(k,605) * lu(k,1292) + lu(k,1297) = lu(k,1297) - lu(k,606) * lu(k,1292) + lu(k,1298) = lu(k,1298) - lu(k,607) * lu(k,1292) + lu(k,1299) = - lu(k,608) * lu(k,1292) + lu(k,1300) = - lu(k,609) * lu(k,1292) + lu(k,1301) = - lu(k,610) * lu(k,1292) + lu(k,1303) = lu(k,1303) - lu(k,611) * lu(k,1292) + lu(k,1305) = - lu(k,612) * lu(k,1292) + lu(k,1306) = - lu(k,613) * lu(k,1292) + lu(k,1307) = lu(k,1307) - lu(k,614) * lu(k,1292) + end do + end subroutine lu_fac13 + subroutine lu_fac14( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,626) = 1._r8 / lu(k,626) + lu(k,627) = lu(k,627) * lu(k,626) + lu(k,628) = lu(k,628) * lu(k,626) + lu(k,629) = lu(k,629) * lu(k,626) + lu(k,630) = lu(k,630) * lu(k,626) + lu(k,631) = lu(k,631) * lu(k,626) + lu(k,632) = lu(k,632) * lu(k,626) + lu(k,633) = lu(k,633) * lu(k,626) + lu(k,634) = lu(k,634) * lu(k,626) + lu(k,635) = lu(k,635) * lu(k,626) + lu(k,636) = lu(k,636) * lu(k,626) + lu(k,637) = lu(k,637) * lu(k,626) + lu(k,638) = lu(k,638) * lu(k,626) + lu(k,639) = lu(k,639) * lu(k,626) + lu(k,640) = lu(k,640) * lu(k,626) + lu(k,693) = lu(k,693) - lu(k,627) * lu(k,692) + lu(k,694) = lu(k,694) - lu(k,628) * lu(k,692) + lu(k,695) = lu(k,695) - lu(k,629) * lu(k,692) + lu(k,696) = lu(k,696) - lu(k,630) * lu(k,692) + lu(k,697) = lu(k,697) - lu(k,631) * lu(k,692) + lu(k,698) = lu(k,698) - lu(k,632) * lu(k,692) + lu(k,699) = lu(k,699) - lu(k,633) * lu(k,692) + lu(k,700) = lu(k,700) - lu(k,634) * lu(k,692) + lu(k,701) = lu(k,701) - lu(k,635) * lu(k,692) + lu(k,702) = lu(k,702) - lu(k,636) * lu(k,692) + lu(k,703) = lu(k,703) - lu(k,637) * lu(k,692) + lu(k,704) = lu(k,704) - lu(k,638) * lu(k,692) + lu(k,705) = lu(k,705) - lu(k,639) * lu(k,692) + lu(k,706) = lu(k,706) - lu(k,640) * lu(k,692) + lu(k,749) = lu(k,749) - lu(k,627) * lu(k,748) + lu(k,750) = lu(k,750) - lu(k,628) * lu(k,748) + lu(k,751) = lu(k,751) - lu(k,629) * lu(k,748) + lu(k,752) = lu(k,752) - lu(k,630) * lu(k,748) + lu(k,753) = lu(k,753) - lu(k,631) * lu(k,748) + lu(k,755) = lu(k,755) - lu(k,632) * lu(k,748) + lu(k,758) = lu(k,758) - lu(k,633) * lu(k,748) + lu(k,759) = lu(k,759) - lu(k,634) * lu(k,748) + lu(k,760) = lu(k,760) - lu(k,635) * lu(k,748) + lu(k,761) = lu(k,761) - lu(k,636) * lu(k,748) + lu(k,763) = lu(k,763) - lu(k,637) * lu(k,748) + lu(k,764) = lu(k,764) - lu(k,638) * lu(k,748) + lu(k,766) = lu(k,766) - lu(k,639) * lu(k,748) + lu(k,767) = lu(k,767) - lu(k,640) * lu(k,748) + lu(k,932) = lu(k,932) - lu(k,627) * lu(k,931) + lu(k,933) = lu(k,933) - lu(k,628) * lu(k,931) + lu(k,934) = lu(k,934) - lu(k,629) * lu(k,931) + lu(k,935) = lu(k,935) - lu(k,630) * lu(k,931) + lu(k,936) = lu(k,936) - lu(k,631) * lu(k,931) + lu(k,938) = lu(k,938) - lu(k,632) * lu(k,931) + lu(k,942) = lu(k,942) - lu(k,633) * lu(k,931) + lu(k,943) = lu(k,943) - lu(k,634) * lu(k,931) + lu(k,945) = lu(k,945) - lu(k,635) * lu(k,931) + lu(k,946) = lu(k,946) - lu(k,636) * lu(k,931) + lu(k,948) = lu(k,948) - lu(k,637) * lu(k,931) + lu(k,949) = lu(k,949) - lu(k,638) * lu(k,931) + lu(k,951) = lu(k,951) - lu(k,639) * lu(k,931) + lu(k,952) = lu(k,952) - lu(k,640) * lu(k,931) + lu(k,998) = lu(k,998) - lu(k,627) * lu(k,997) + lu(k,999) = lu(k,999) - lu(k,628) * lu(k,997) + lu(k,1000) = lu(k,1000) - lu(k,629) * lu(k,997) + lu(k,1001) = lu(k,1001) - lu(k,630) * lu(k,997) + lu(k,1002) = lu(k,1002) - lu(k,631) * lu(k,997) + lu(k,1004) = lu(k,1004) - lu(k,632) * lu(k,997) + lu(k,1008) = lu(k,1008) - lu(k,633) * lu(k,997) + lu(k,1009) = lu(k,1009) - lu(k,634) * lu(k,997) + lu(k,1011) = lu(k,1011) - lu(k,635) * lu(k,997) + lu(k,1012) = lu(k,1012) - lu(k,636) * lu(k,997) + lu(k,1014) = lu(k,1014) - lu(k,637) * lu(k,997) + lu(k,1015) = lu(k,1015) - lu(k,638) * lu(k,997) + lu(k,1017) = lu(k,1017) - lu(k,639) * lu(k,997) + lu(k,1018) = lu(k,1018) - lu(k,640) * lu(k,997) + lu(k,1156) = lu(k,1156) - lu(k,627) * lu(k,1155) + lu(k,1157) = lu(k,1157) - lu(k,628) * lu(k,1155) + lu(k,1158) = lu(k,1158) - lu(k,629) * lu(k,1155) + lu(k,1159) = lu(k,1159) - lu(k,630) * lu(k,1155) + lu(k,1160) = lu(k,1160) - lu(k,631) * lu(k,1155) + lu(k,1162) = lu(k,1162) - lu(k,632) * lu(k,1155) + lu(k,1166) = lu(k,1166) - lu(k,633) * lu(k,1155) + lu(k,1167) = lu(k,1167) - lu(k,634) * lu(k,1155) + lu(k,1169) = lu(k,1169) - lu(k,635) * lu(k,1155) + lu(k,1170) = lu(k,1170) - lu(k,636) * lu(k,1155) + lu(k,1172) = lu(k,1172) - lu(k,637) * lu(k,1155) + lu(k,1173) = lu(k,1173) - lu(k,638) * lu(k,1155) + lu(k,1175) = lu(k,1175) - lu(k,639) * lu(k,1155) + lu(k,1176) = lu(k,1176) - lu(k,640) * lu(k,1155) + lu(k,1200) = lu(k,1200) - lu(k,627) * lu(k,1199) + lu(k,1201) = lu(k,1201) - lu(k,628) * lu(k,1199) + lu(k,1202) = lu(k,1202) - lu(k,629) * lu(k,1199) + lu(k,1203) = lu(k,1203) - lu(k,630) * lu(k,1199) + lu(k,1204) = lu(k,1204) - lu(k,631) * lu(k,1199) + lu(k,1206) = lu(k,1206) - lu(k,632) * lu(k,1199) + lu(k,1210) = lu(k,1210) - lu(k,633) * lu(k,1199) + lu(k,1211) = lu(k,1211) - lu(k,634) * lu(k,1199) + lu(k,1213) = lu(k,1213) - lu(k,635) * lu(k,1199) + lu(k,1214) = lu(k,1214) - lu(k,636) * lu(k,1199) + lu(k,1216) = lu(k,1216) - lu(k,637) * lu(k,1199) + lu(k,1217) = lu(k,1217) - lu(k,638) * lu(k,1199) + lu(k,1219) = lu(k,1219) - lu(k,639) * lu(k,1199) + lu(k,1220) = lu(k,1220) - lu(k,640) * lu(k,1199) + lu(k,1267) = lu(k,1267) - lu(k,627) * lu(k,1266) + lu(k,1268) = lu(k,1268) - lu(k,628) * lu(k,1266) + lu(k,1269) = lu(k,1269) - lu(k,629) * lu(k,1266) + lu(k,1270) = lu(k,1270) - lu(k,630) * lu(k,1266) + lu(k,1271) = lu(k,1271) - lu(k,631) * lu(k,1266) + lu(k,1273) = lu(k,1273) - lu(k,632) * lu(k,1266) + lu(k,1277) = lu(k,1277) - lu(k,633) * lu(k,1266) + lu(k,1278) = lu(k,1278) - lu(k,634) * lu(k,1266) + lu(k,1280) = lu(k,1280) - lu(k,635) * lu(k,1266) + lu(k,1281) = lu(k,1281) - lu(k,636) * lu(k,1266) + lu(k,1283) = lu(k,1283) - lu(k,637) * lu(k,1266) + lu(k,1284) = lu(k,1284) - lu(k,638) * lu(k,1266) + lu(k,1286) = lu(k,1286) - lu(k,639) * lu(k,1266) + lu(k,1287) = lu(k,1287) - lu(k,640) * lu(k,1266) + lu(k,649) = 1._r8 / lu(k,649) + lu(k,650) = lu(k,650) * lu(k,649) + lu(k,651) = lu(k,651) * lu(k,649) + lu(k,652) = lu(k,652) * lu(k,649) + lu(k,653) = lu(k,653) * lu(k,649) + lu(k,654) = lu(k,654) * lu(k,649) + lu(k,655) = lu(k,655) * lu(k,649) + lu(k,656) = lu(k,656) * lu(k,649) + lu(k,657) = lu(k,657) * lu(k,649) + lu(k,658) = lu(k,658) * lu(k,649) + lu(k,659) = lu(k,659) * lu(k,649) + lu(k,660) = lu(k,660) * lu(k,649) + lu(k,694) = lu(k,694) - lu(k,650) * lu(k,693) + lu(k,695) = lu(k,695) - lu(k,651) * lu(k,693) + lu(k,697) = lu(k,697) - lu(k,652) * lu(k,693) + lu(k,698) = lu(k,698) - lu(k,653) * lu(k,693) + lu(k,699) = lu(k,699) - lu(k,654) * lu(k,693) + lu(k,700) = lu(k,700) - lu(k,655) * lu(k,693) + lu(k,702) = lu(k,702) - lu(k,656) * lu(k,693) + lu(k,703) = lu(k,703) - lu(k,657) * lu(k,693) + lu(k,704) = lu(k,704) - lu(k,658) * lu(k,693) + lu(k,705) = lu(k,705) - lu(k,659) * lu(k,693) + lu(k,706) = lu(k,706) - lu(k,660) * lu(k,693) + lu(k,713) = - lu(k,650) * lu(k,712) + lu(k,714) = lu(k,714) - lu(k,651) * lu(k,712) + lu(k,716) = lu(k,716) - lu(k,652) * lu(k,712) + lu(k,718) = lu(k,718) - lu(k,653) * lu(k,712) + lu(k,721) = lu(k,721) - lu(k,654) * lu(k,712) + lu(k,722) = lu(k,722) - lu(k,655) * lu(k,712) + lu(k,724) = lu(k,724) - lu(k,656) * lu(k,712) + lu(k,726) = lu(k,726) - lu(k,657) * lu(k,712) + lu(k,727) = lu(k,727) - lu(k,658) * lu(k,712) + lu(k,728) = lu(k,728) - lu(k,659) * lu(k,712) + lu(k,729) = lu(k,729) - lu(k,660) * lu(k,712) + lu(k,750) = lu(k,750) - lu(k,650) * lu(k,749) + lu(k,751) = lu(k,751) - lu(k,651) * lu(k,749) + lu(k,753) = lu(k,753) - lu(k,652) * lu(k,749) + lu(k,755) = lu(k,755) - lu(k,653) * lu(k,749) + lu(k,758) = lu(k,758) - lu(k,654) * lu(k,749) + lu(k,759) = lu(k,759) - lu(k,655) * lu(k,749) + lu(k,761) = lu(k,761) - lu(k,656) * lu(k,749) + lu(k,763) = lu(k,763) - lu(k,657) * lu(k,749) + lu(k,764) = lu(k,764) - lu(k,658) * lu(k,749) + lu(k,766) = lu(k,766) - lu(k,659) * lu(k,749) + lu(k,767) = lu(k,767) - lu(k,660) * lu(k,749) + lu(k,933) = lu(k,933) - lu(k,650) * lu(k,932) + lu(k,934) = lu(k,934) - lu(k,651) * lu(k,932) + lu(k,936) = lu(k,936) - lu(k,652) * lu(k,932) + lu(k,938) = lu(k,938) - lu(k,653) * lu(k,932) + lu(k,942) = lu(k,942) - lu(k,654) * lu(k,932) + lu(k,943) = lu(k,943) - lu(k,655) * lu(k,932) + lu(k,946) = lu(k,946) - lu(k,656) * lu(k,932) + lu(k,948) = lu(k,948) - lu(k,657) * lu(k,932) + lu(k,949) = lu(k,949) - lu(k,658) * lu(k,932) + lu(k,951) = lu(k,951) - lu(k,659) * lu(k,932) + lu(k,952) = lu(k,952) - lu(k,660) * lu(k,932) + lu(k,999) = lu(k,999) - lu(k,650) * lu(k,998) + lu(k,1000) = lu(k,1000) - lu(k,651) * lu(k,998) + lu(k,1002) = lu(k,1002) - lu(k,652) * lu(k,998) + lu(k,1004) = lu(k,1004) - lu(k,653) * lu(k,998) + lu(k,1008) = lu(k,1008) - lu(k,654) * lu(k,998) + lu(k,1009) = lu(k,1009) - lu(k,655) * lu(k,998) + lu(k,1012) = lu(k,1012) - lu(k,656) * lu(k,998) + lu(k,1014) = lu(k,1014) - lu(k,657) * lu(k,998) + lu(k,1015) = lu(k,1015) - lu(k,658) * lu(k,998) + lu(k,1017) = lu(k,1017) - lu(k,659) * lu(k,998) + lu(k,1018) = lu(k,1018) - lu(k,660) * lu(k,998) + lu(k,1157) = lu(k,1157) - lu(k,650) * lu(k,1156) + lu(k,1158) = lu(k,1158) - lu(k,651) * lu(k,1156) + lu(k,1160) = lu(k,1160) - lu(k,652) * lu(k,1156) + lu(k,1162) = lu(k,1162) - lu(k,653) * lu(k,1156) + lu(k,1166) = lu(k,1166) - lu(k,654) * lu(k,1156) + lu(k,1167) = lu(k,1167) - lu(k,655) * lu(k,1156) + lu(k,1170) = lu(k,1170) - lu(k,656) * lu(k,1156) + lu(k,1172) = lu(k,1172) - lu(k,657) * lu(k,1156) + lu(k,1173) = lu(k,1173) - lu(k,658) * lu(k,1156) + lu(k,1175) = lu(k,1175) - lu(k,659) * lu(k,1156) + lu(k,1176) = lu(k,1176) - lu(k,660) * lu(k,1156) + lu(k,1201) = lu(k,1201) - lu(k,650) * lu(k,1200) + lu(k,1202) = lu(k,1202) - lu(k,651) * lu(k,1200) + lu(k,1204) = lu(k,1204) - lu(k,652) * lu(k,1200) + lu(k,1206) = lu(k,1206) - lu(k,653) * lu(k,1200) + lu(k,1210) = lu(k,1210) - lu(k,654) * lu(k,1200) + lu(k,1211) = lu(k,1211) - lu(k,655) * lu(k,1200) + lu(k,1214) = lu(k,1214) - lu(k,656) * lu(k,1200) + lu(k,1216) = lu(k,1216) - lu(k,657) * lu(k,1200) + lu(k,1217) = lu(k,1217) - lu(k,658) * lu(k,1200) + lu(k,1219) = lu(k,1219) - lu(k,659) * lu(k,1200) + lu(k,1220) = lu(k,1220) - lu(k,660) * lu(k,1200) + lu(k,1268) = lu(k,1268) - lu(k,650) * lu(k,1267) + lu(k,1269) = lu(k,1269) - lu(k,651) * lu(k,1267) + lu(k,1271) = lu(k,1271) - lu(k,652) * lu(k,1267) + lu(k,1273) = lu(k,1273) - lu(k,653) * lu(k,1267) + lu(k,1277) = lu(k,1277) - lu(k,654) * lu(k,1267) + lu(k,1278) = lu(k,1278) - lu(k,655) * lu(k,1267) + lu(k,1281) = lu(k,1281) - lu(k,656) * lu(k,1267) + lu(k,1283) = lu(k,1283) - lu(k,657) * lu(k,1267) + lu(k,1284) = lu(k,1284) - lu(k,658) * lu(k,1267) + lu(k,1286) = lu(k,1286) - lu(k,659) * lu(k,1267) + lu(k,1287) = lu(k,1287) - lu(k,660) * lu(k,1267) + lu(k,668) = 1._r8 / lu(k,668) + lu(k,669) = lu(k,669) * lu(k,668) + lu(k,670) = lu(k,670) * lu(k,668) + lu(k,671) = lu(k,671) * lu(k,668) + lu(k,672) = lu(k,672) * lu(k,668) + lu(k,673) = lu(k,673) * lu(k,668) + lu(k,674) = lu(k,674) * lu(k,668) + lu(k,675) = lu(k,675) * lu(k,668) + lu(k,676) = lu(k,676) * lu(k,668) + lu(k,677) = lu(k,677) * lu(k,668) + lu(k,678) = lu(k,678) * lu(k,668) + lu(k,679) = lu(k,679) * lu(k,668) + lu(k,695) = lu(k,695) - lu(k,669) * lu(k,694) + lu(k,697) = lu(k,697) - lu(k,670) * lu(k,694) + lu(k,698) = lu(k,698) - lu(k,671) * lu(k,694) + lu(k,699) = lu(k,699) - lu(k,672) * lu(k,694) + lu(k,700) = lu(k,700) - lu(k,673) * lu(k,694) + lu(k,701) = lu(k,701) - lu(k,674) * lu(k,694) + lu(k,702) = lu(k,702) - lu(k,675) * lu(k,694) + lu(k,703) = lu(k,703) - lu(k,676) * lu(k,694) + lu(k,704) = lu(k,704) - lu(k,677) * lu(k,694) + lu(k,705) = lu(k,705) - lu(k,678) * lu(k,694) + lu(k,706) = lu(k,706) - lu(k,679) * lu(k,694) + lu(k,714) = lu(k,714) - lu(k,669) * lu(k,713) + lu(k,716) = lu(k,716) - lu(k,670) * lu(k,713) + lu(k,718) = lu(k,718) - lu(k,671) * lu(k,713) + lu(k,721) = lu(k,721) - lu(k,672) * lu(k,713) + lu(k,722) = lu(k,722) - lu(k,673) * lu(k,713) + lu(k,723) = lu(k,723) - lu(k,674) * lu(k,713) + lu(k,724) = lu(k,724) - lu(k,675) * lu(k,713) + lu(k,726) = lu(k,726) - lu(k,676) * lu(k,713) + lu(k,727) = lu(k,727) - lu(k,677) * lu(k,713) + lu(k,728) = lu(k,728) - lu(k,678) * lu(k,713) + lu(k,729) = lu(k,729) - lu(k,679) * lu(k,713) + lu(k,751) = lu(k,751) - lu(k,669) * lu(k,750) + lu(k,753) = lu(k,753) - lu(k,670) * lu(k,750) + lu(k,755) = lu(k,755) - lu(k,671) * lu(k,750) + lu(k,758) = lu(k,758) - lu(k,672) * lu(k,750) + lu(k,759) = lu(k,759) - lu(k,673) * lu(k,750) + lu(k,760) = lu(k,760) - lu(k,674) * lu(k,750) + lu(k,761) = lu(k,761) - lu(k,675) * lu(k,750) + lu(k,763) = lu(k,763) - lu(k,676) * lu(k,750) + lu(k,764) = lu(k,764) - lu(k,677) * lu(k,750) + lu(k,766) = lu(k,766) - lu(k,678) * lu(k,750) + lu(k,767) = lu(k,767) - lu(k,679) * lu(k,750) + lu(k,934) = lu(k,934) - lu(k,669) * lu(k,933) + lu(k,936) = lu(k,936) - lu(k,670) * lu(k,933) + lu(k,938) = lu(k,938) - lu(k,671) * lu(k,933) + lu(k,942) = lu(k,942) - lu(k,672) * lu(k,933) + lu(k,943) = lu(k,943) - lu(k,673) * lu(k,933) + lu(k,945) = lu(k,945) - lu(k,674) * lu(k,933) + lu(k,946) = lu(k,946) - lu(k,675) * lu(k,933) + lu(k,948) = lu(k,948) - lu(k,676) * lu(k,933) + lu(k,949) = lu(k,949) - lu(k,677) * lu(k,933) + lu(k,951) = lu(k,951) - lu(k,678) * lu(k,933) + lu(k,952) = lu(k,952) - lu(k,679) * lu(k,933) + lu(k,1000) = lu(k,1000) - lu(k,669) * lu(k,999) + lu(k,1002) = lu(k,1002) - lu(k,670) * lu(k,999) + lu(k,1004) = lu(k,1004) - lu(k,671) * lu(k,999) + lu(k,1008) = lu(k,1008) - lu(k,672) * lu(k,999) + lu(k,1009) = lu(k,1009) - lu(k,673) * lu(k,999) + lu(k,1011) = lu(k,1011) - lu(k,674) * lu(k,999) + lu(k,1012) = lu(k,1012) - lu(k,675) * lu(k,999) + lu(k,1014) = lu(k,1014) - lu(k,676) * lu(k,999) + lu(k,1015) = lu(k,1015) - lu(k,677) * lu(k,999) + lu(k,1017) = lu(k,1017) - lu(k,678) * lu(k,999) + lu(k,1018) = lu(k,1018) - lu(k,679) * lu(k,999) + lu(k,1036) = lu(k,1036) - lu(k,669) * lu(k,1035) + lu(k,1038) = lu(k,1038) - lu(k,670) * lu(k,1035) + lu(k,1040) = lu(k,1040) - lu(k,671) * lu(k,1035) + lu(k,1044) = lu(k,1044) - lu(k,672) * lu(k,1035) + lu(k,1045) = lu(k,1045) - lu(k,673) * lu(k,1035) + lu(k,1047) = lu(k,1047) - lu(k,674) * lu(k,1035) + lu(k,1048) = lu(k,1048) - lu(k,675) * lu(k,1035) + lu(k,1050) = lu(k,1050) - lu(k,676) * lu(k,1035) + lu(k,1051) = lu(k,1051) - lu(k,677) * lu(k,1035) + lu(k,1053) = lu(k,1053) - lu(k,678) * lu(k,1035) + lu(k,1054) = lu(k,1054) - lu(k,679) * lu(k,1035) + lu(k,1158) = lu(k,1158) - lu(k,669) * lu(k,1157) + lu(k,1160) = lu(k,1160) - lu(k,670) * lu(k,1157) + lu(k,1162) = lu(k,1162) - lu(k,671) * lu(k,1157) + lu(k,1166) = lu(k,1166) - lu(k,672) * lu(k,1157) + lu(k,1167) = lu(k,1167) - lu(k,673) * lu(k,1157) + lu(k,1169) = lu(k,1169) - lu(k,674) * lu(k,1157) + lu(k,1170) = lu(k,1170) - lu(k,675) * lu(k,1157) + lu(k,1172) = lu(k,1172) - lu(k,676) * lu(k,1157) + lu(k,1173) = lu(k,1173) - lu(k,677) * lu(k,1157) + lu(k,1175) = lu(k,1175) - lu(k,678) * lu(k,1157) + lu(k,1176) = lu(k,1176) - lu(k,679) * lu(k,1157) + lu(k,1202) = lu(k,1202) - lu(k,669) * lu(k,1201) + lu(k,1204) = lu(k,1204) - lu(k,670) * lu(k,1201) + lu(k,1206) = lu(k,1206) - lu(k,671) * lu(k,1201) + lu(k,1210) = lu(k,1210) - lu(k,672) * lu(k,1201) + lu(k,1211) = lu(k,1211) - lu(k,673) * lu(k,1201) + lu(k,1213) = lu(k,1213) - lu(k,674) * lu(k,1201) + lu(k,1214) = lu(k,1214) - lu(k,675) * lu(k,1201) + lu(k,1216) = lu(k,1216) - lu(k,676) * lu(k,1201) + lu(k,1217) = lu(k,1217) - lu(k,677) * lu(k,1201) + lu(k,1219) = lu(k,1219) - lu(k,678) * lu(k,1201) + lu(k,1220) = lu(k,1220) - lu(k,679) * lu(k,1201) + lu(k,1269) = lu(k,1269) - lu(k,669) * lu(k,1268) + lu(k,1271) = lu(k,1271) - lu(k,670) * lu(k,1268) + lu(k,1273) = lu(k,1273) - lu(k,671) * lu(k,1268) + lu(k,1277) = lu(k,1277) - lu(k,672) * lu(k,1268) + lu(k,1278) = lu(k,1278) - lu(k,673) * lu(k,1268) + lu(k,1280) = lu(k,1280) - lu(k,674) * lu(k,1268) + lu(k,1281) = lu(k,1281) - lu(k,675) * lu(k,1268) + lu(k,1283) = lu(k,1283) - lu(k,676) * lu(k,1268) + lu(k,1284) = lu(k,1284) - lu(k,677) * lu(k,1268) + lu(k,1286) = lu(k,1286) - lu(k,678) * lu(k,1268) + lu(k,1287) = lu(k,1287) - lu(k,679) * lu(k,1268) + lu(k,695) = 1._r8 / lu(k,695) + lu(k,696) = lu(k,696) * lu(k,695) + lu(k,697) = lu(k,697) * lu(k,695) + lu(k,698) = lu(k,698) * lu(k,695) + lu(k,699) = lu(k,699) * lu(k,695) + lu(k,700) = lu(k,700) * lu(k,695) + lu(k,701) = lu(k,701) * lu(k,695) + lu(k,702) = lu(k,702) * lu(k,695) + lu(k,703) = lu(k,703) * lu(k,695) + lu(k,704) = lu(k,704) * lu(k,695) + lu(k,705) = lu(k,705) * lu(k,695) + lu(k,706) = lu(k,706) * lu(k,695) + lu(k,715) = lu(k,715) - lu(k,696) * lu(k,714) + lu(k,716) = lu(k,716) - lu(k,697) * lu(k,714) + lu(k,718) = lu(k,718) - lu(k,698) * lu(k,714) + lu(k,721) = lu(k,721) - lu(k,699) * lu(k,714) + lu(k,722) = lu(k,722) - lu(k,700) * lu(k,714) + lu(k,723) = lu(k,723) - lu(k,701) * lu(k,714) + lu(k,724) = lu(k,724) - lu(k,702) * lu(k,714) + lu(k,726) = lu(k,726) - lu(k,703) * lu(k,714) + lu(k,727) = lu(k,727) - lu(k,704) * lu(k,714) + lu(k,728) = lu(k,728) - lu(k,705) * lu(k,714) + lu(k,729) = lu(k,729) - lu(k,706) * lu(k,714) + lu(k,752) = lu(k,752) - lu(k,696) * lu(k,751) + lu(k,753) = lu(k,753) - lu(k,697) * lu(k,751) + lu(k,755) = lu(k,755) - lu(k,698) * lu(k,751) + lu(k,758) = lu(k,758) - lu(k,699) * lu(k,751) + lu(k,759) = lu(k,759) - lu(k,700) * lu(k,751) + lu(k,760) = lu(k,760) - lu(k,701) * lu(k,751) + lu(k,761) = lu(k,761) - lu(k,702) * lu(k,751) + lu(k,763) = lu(k,763) - lu(k,703) * lu(k,751) + lu(k,764) = lu(k,764) - lu(k,704) * lu(k,751) + lu(k,766) = lu(k,766) - lu(k,705) * lu(k,751) + lu(k,767) = lu(k,767) - lu(k,706) * lu(k,751) + lu(k,850) = - lu(k,696) * lu(k,849) + lu(k,851) = lu(k,851) - lu(k,697) * lu(k,849) + lu(k,853) = lu(k,853) - lu(k,698) * lu(k,849) + lu(k,857) = lu(k,857) - lu(k,699) * lu(k,849) + lu(k,858) = lu(k,858) - lu(k,700) * lu(k,849) + lu(k,860) = lu(k,860) - lu(k,701) * lu(k,849) + lu(k,861) = lu(k,861) - lu(k,702) * lu(k,849) + lu(k,863) = lu(k,863) - lu(k,703) * lu(k,849) + lu(k,864) = lu(k,864) - lu(k,704) * lu(k,849) + lu(k,866) = lu(k,866) - lu(k,705) * lu(k,849) + lu(k,867) = lu(k,867) - lu(k,706) * lu(k,849) + lu(k,935) = lu(k,935) - lu(k,696) * lu(k,934) + lu(k,936) = lu(k,936) - lu(k,697) * lu(k,934) + lu(k,938) = lu(k,938) - lu(k,698) * lu(k,934) + lu(k,942) = lu(k,942) - lu(k,699) * lu(k,934) + lu(k,943) = lu(k,943) - lu(k,700) * lu(k,934) + lu(k,945) = lu(k,945) - lu(k,701) * lu(k,934) + lu(k,946) = lu(k,946) - lu(k,702) * lu(k,934) + lu(k,948) = lu(k,948) - lu(k,703) * lu(k,934) + lu(k,949) = lu(k,949) - lu(k,704) * lu(k,934) + lu(k,951) = lu(k,951) - lu(k,705) * lu(k,934) + lu(k,952) = lu(k,952) - lu(k,706) * lu(k,934) + lu(k,1001) = lu(k,1001) - lu(k,696) * lu(k,1000) + lu(k,1002) = lu(k,1002) - lu(k,697) * lu(k,1000) + lu(k,1004) = lu(k,1004) - lu(k,698) * lu(k,1000) + lu(k,1008) = lu(k,1008) - lu(k,699) * lu(k,1000) + lu(k,1009) = lu(k,1009) - lu(k,700) * lu(k,1000) + lu(k,1011) = lu(k,1011) - lu(k,701) * lu(k,1000) + lu(k,1012) = lu(k,1012) - lu(k,702) * lu(k,1000) + lu(k,1014) = lu(k,1014) - lu(k,703) * lu(k,1000) + lu(k,1015) = lu(k,1015) - lu(k,704) * lu(k,1000) + lu(k,1017) = lu(k,1017) - lu(k,705) * lu(k,1000) + lu(k,1018) = lu(k,1018) - lu(k,706) * lu(k,1000) + lu(k,1037) = - lu(k,696) * lu(k,1036) + lu(k,1038) = lu(k,1038) - lu(k,697) * lu(k,1036) + lu(k,1040) = lu(k,1040) - lu(k,698) * lu(k,1036) + lu(k,1044) = lu(k,1044) - lu(k,699) * lu(k,1036) + lu(k,1045) = lu(k,1045) - lu(k,700) * lu(k,1036) + lu(k,1047) = lu(k,1047) - lu(k,701) * lu(k,1036) + lu(k,1048) = lu(k,1048) - lu(k,702) * lu(k,1036) + lu(k,1050) = lu(k,1050) - lu(k,703) * lu(k,1036) + lu(k,1051) = lu(k,1051) - lu(k,704) * lu(k,1036) + lu(k,1053) = lu(k,1053) - lu(k,705) * lu(k,1036) + lu(k,1054) = lu(k,1054) - lu(k,706) * lu(k,1036) + lu(k,1159) = lu(k,1159) - lu(k,696) * lu(k,1158) + lu(k,1160) = lu(k,1160) - lu(k,697) * lu(k,1158) + lu(k,1162) = lu(k,1162) - lu(k,698) * lu(k,1158) + lu(k,1166) = lu(k,1166) - lu(k,699) * lu(k,1158) + lu(k,1167) = lu(k,1167) - lu(k,700) * lu(k,1158) + lu(k,1169) = lu(k,1169) - lu(k,701) * lu(k,1158) + lu(k,1170) = lu(k,1170) - lu(k,702) * lu(k,1158) + lu(k,1172) = lu(k,1172) - lu(k,703) * lu(k,1158) + lu(k,1173) = lu(k,1173) - lu(k,704) * lu(k,1158) + lu(k,1175) = lu(k,1175) - lu(k,705) * lu(k,1158) + lu(k,1176) = lu(k,1176) - lu(k,706) * lu(k,1158) + lu(k,1203) = lu(k,1203) - lu(k,696) * lu(k,1202) + lu(k,1204) = lu(k,1204) - lu(k,697) * lu(k,1202) + lu(k,1206) = lu(k,1206) - lu(k,698) * lu(k,1202) + lu(k,1210) = lu(k,1210) - lu(k,699) * lu(k,1202) + lu(k,1211) = lu(k,1211) - lu(k,700) * lu(k,1202) + lu(k,1213) = lu(k,1213) - lu(k,701) * lu(k,1202) + lu(k,1214) = lu(k,1214) - lu(k,702) * lu(k,1202) + lu(k,1216) = lu(k,1216) - lu(k,703) * lu(k,1202) + lu(k,1217) = lu(k,1217) - lu(k,704) * lu(k,1202) + lu(k,1219) = lu(k,1219) - lu(k,705) * lu(k,1202) + lu(k,1220) = lu(k,1220) - lu(k,706) * lu(k,1202) + lu(k,1270) = lu(k,1270) - lu(k,696) * lu(k,1269) + lu(k,1271) = lu(k,1271) - lu(k,697) * lu(k,1269) + lu(k,1273) = lu(k,1273) - lu(k,698) * lu(k,1269) + lu(k,1277) = lu(k,1277) - lu(k,699) * lu(k,1269) + lu(k,1278) = lu(k,1278) - lu(k,700) * lu(k,1269) + lu(k,1280) = lu(k,1280) - lu(k,701) * lu(k,1269) + lu(k,1281) = lu(k,1281) - lu(k,702) * lu(k,1269) + lu(k,1283) = lu(k,1283) - lu(k,703) * lu(k,1269) + lu(k,1284) = lu(k,1284) - lu(k,704) * lu(k,1269) + lu(k,1286) = lu(k,1286) - lu(k,705) * lu(k,1269) + lu(k,1287) = lu(k,1287) - lu(k,706) * lu(k,1269) + end do + end subroutine lu_fac14 + subroutine lu_fac15( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,715) = 1._r8 / lu(k,715) + lu(k,716) = lu(k,716) * lu(k,715) + lu(k,717) = lu(k,717) * lu(k,715) + lu(k,718) = lu(k,718) * lu(k,715) + lu(k,719) = lu(k,719) * lu(k,715) + lu(k,720) = lu(k,720) * lu(k,715) + lu(k,721) = lu(k,721) * lu(k,715) + lu(k,722) = lu(k,722) * lu(k,715) + lu(k,723) = lu(k,723) * lu(k,715) + lu(k,724) = lu(k,724) * lu(k,715) + lu(k,725) = lu(k,725) * lu(k,715) + lu(k,726) = lu(k,726) * lu(k,715) + lu(k,727) = lu(k,727) * lu(k,715) + lu(k,728) = lu(k,728) * lu(k,715) + lu(k,729) = lu(k,729) * lu(k,715) + lu(k,753) = lu(k,753) - lu(k,716) * lu(k,752) + lu(k,754) = lu(k,754) - lu(k,717) * lu(k,752) + lu(k,755) = lu(k,755) - lu(k,718) * lu(k,752) + lu(k,756) = - lu(k,719) * lu(k,752) + lu(k,757) = lu(k,757) - lu(k,720) * lu(k,752) + lu(k,758) = lu(k,758) - lu(k,721) * lu(k,752) + lu(k,759) = lu(k,759) - lu(k,722) * lu(k,752) + lu(k,760) = lu(k,760) - lu(k,723) * lu(k,752) + lu(k,761) = lu(k,761) - lu(k,724) * lu(k,752) + lu(k,762) = - lu(k,725) * lu(k,752) + lu(k,763) = lu(k,763) - lu(k,726) * lu(k,752) + lu(k,764) = lu(k,764) - lu(k,727) * lu(k,752) + lu(k,766) = lu(k,766) - lu(k,728) * lu(k,752) + lu(k,767) = lu(k,767) - lu(k,729) * lu(k,752) + lu(k,851) = lu(k,851) - lu(k,716) * lu(k,850) + lu(k,852) = lu(k,852) - lu(k,717) * lu(k,850) + lu(k,853) = lu(k,853) - lu(k,718) * lu(k,850) + lu(k,855) = lu(k,855) - lu(k,719) * lu(k,850) + lu(k,856) = lu(k,856) - lu(k,720) * lu(k,850) + lu(k,857) = lu(k,857) - lu(k,721) * lu(k,850) + lu(k,858) = lu(k,858) - lu(k,722) * lu(k,850) + lu(k,860) = lu(k,860) - lu(k,723) * lu(k,850) + lu(k,861) = lu(k,861) - lu(k,724) * lu(k,850) + lu(k,862) = lu(k,862) - lu(k,725) * lu(k,850) + lu(k,863) = lu(k,863) - lu(k,726) * lu(k,850) + lu(k,864) = lu(k,864) - lu(k,727) * lu(k,850) + lu(k,866) = lu(k,866) - lu(k,728) * lu(k,850) + lu(k,867) = lu(k,867) - lu(k,729) * lu(k,850) + lu(k,936) = lu(k,936) - lu(k,716) * lu(k,935) + lu(k,937) = lu(k,937) - lu(k,717) * lu(k,935) + lu(k,938) = lu(k,938) - lu(k,718) * lu(k,935) + lu(k,940) = lu(k,940) - lu(k,719) * lu(k,935) + lu(k,941) = lu(k,941) - lu(k,720) * lu(k,935) + lu(k,942) = lu(k,942) - lu(k,721) * lu(k,935) + lu(k,943) = lu(k,943) - lu(k,722) * lu(k,935) + lu(k,945) = lu(k,945) - lu(k,723) * lu(k,935) + lu(k,946) = lu(k,946) - lu(k,724) * lu(k,935) + lu(k,947) = lu(k,947) - lu(k,725) * lu(k,935) + lu(k,948) = lu(k,948) - lu(k,726) * lu(k,935) + lu(k,949) = lu(k,949) - lu(k,727) * lu(k,935) + lu(k,951) = lu(k,951) - lu(k,728) * lu(k,935) + lu(k,952) = lu(k,952) - lu(k,729) * lu(k,935) + lu(k,1002) = lu(k,1002) - lu(k,716) * lu(k,1001) + lu(k,1003) = lu(k,1003) - lu(k,717) * lu(k,1001) + lu(k,1004) = lu(k,1004) - lu(k,718) * lu(k,1001) + lu(k,1006) = lu(k,1006) - lu(k,719) * lu(k,1001) + lu(k,1007) = lu(k,1007) - lu(k,720) * lu(k,1001) + lu(k,1008) = lu(k,1008) - lu(k,721) * lu(k,1001) + lu(k,1009) = lu(k,1009) - lu(k,722) * lu(k,1001) + lu(k,1011) = lu(k,1011) - lu(k,723) * lu(k,1001) + lu(k,1012) = lu(k,1012) - lu(k,724) * lu(k,1001) + lu(k,1013) = lu(k,1013) - lu(k,725) * lu(k,1001) + lu(k,1014) = lu(k,1014) - lu(k,726) * lu(k,1001) + lu(k,1015) = lu(k,1015) - lu(k,727) * lu(k,1001) + lu(k,1017) = lu(k,1017) - lu(k,728) * lu(k,1001) + lu(k,1018) = lu(k,1018) - lu(k,729) * lu(k,1001) + lu(k,1038) = lu(k,1038) - lu(k,716) * lu(k,1037) + lu(k,1039) = lu(k,1039) - lu(k,717) * lu(k,1037) + lu(k,1040) = lu(k,1040) - lu(k,718) * lu(k,1037) + lu(k,1042) = lu(k,1042) - lu(k,719) * lu(k,1037) + lu(k,1043) = lu(k,1043) - lu(k,720) * lu(k,1037) + lu(k,1044) = lu(k,1044) - lu(k,721) * lu(k,1037) + lu(k,1045) = lu(k,1045) - lu(k,722) * lu(k,1037) + lu(k,1047) = lu(k,1047) - lu(k,723) * lu(k,1037) + lu(k,1048) = lu(k,1048) - lu(k,724) * lu(k,1037) + lu(k,1049) = lu(k,1049) - lu(k,725) * lu(k,1037) + lu(k,1050) = lu(k,1050) - lu(k,726) * lu(k,1037) + lu(k,1051) = lu(k,1051) - lu(k,727) * lu(k,1037) + lu(k,1053) = lu(k,1053) - lu(k,728) * lu(k,1037) + lu(k,1054) = lu(k,1054) - lu(k,729) * lu(k,1037) + lu(k,1160) = lu(k,1160) - lu(k,716) * lu(k,1159) + lu(k,1161) = lu(k,1161) - lu(k,717) * lu(k,1159) + lu(k,1162) = lu(k,1162) - lu(k,718) * lu(k,1159) + lu(k,1164) = lu(k,1164) - lu(k,719) * lu(k,1159) + lu(k,1165) = lu(k,1165) - lu(k,720) * lu(k,1159) + lu(k,1166) = lu(k,1166) - lu(k,721) * lu(k,1159) + lu(k,1167) = lu(k,1167) - lu(k,722) * lu(k,1159) + lu(k,1169) = lu(k,1169) - lu(k,723) * lu(k,1159) + lu(k,1170) = lu(k,1170) - lu(k,724) * lu(k,1159) + lu(k,1171) = lu(k,1171) - lu(k,725) * lu(k,1159) + lu(k,1172) = lu(k,1172) - lu(k,726) * lu(k,1159) + lu(k,1173) = lu(k,1173) - lu(k,727) * lu(k,1159) + lu(k,1175) = lu(k,1175) - lu(k,728) * lu(k,1159) + lu(k,1176) = lu(k,1176) - lu(k,729) * lu(k,1159) + lu(k,1204) = lu(k,1204) - lu(k,716) * lu(k,1203) + lu(k,1205) = lu(k,1205) - lu(k,717) * lu(k,1203) + lu(k,1206) = lu(k,1206) - lu(k,718) * lu(k,1203) + lu(k,1208) = lu(k,1208) - lu(k,719) * lu(k,1203) + lu(k,1209) = lu(k,1209) - lu(k,720) * lu(k,1203) + lu(k,1210) = lu(k,1210) - lu(k,721) * lu(k,1203) + lu(k,1211) = lu(k,1211) - lu(k,722) * lu(k,1203) + lu(k,1213) = lu(k,1213) - lu(k,723) * lu(k,1203) + lu(k,1214) = lu(k,1214) - lu(k,724) * lu(k,1203) + lu(k,1215) = lu(k,1215) - lu(k,725) * lu(k,1203) + lu(k,1216) = lu(k,1216) - lu(k,726) * lu(k,1203) + lu(k,1217) = lu(k,1217) - lu(k,727) * lu(k,1203) + lu(k,1219) = lu(k,1219) - lu(k,728) * lu(k,1203) + lu(k,1220) = lu(k,1220) - lu(k,729) * lu(k,1203) + lu(k,1271) = lu(k,1271) - lu(k,716) * lu(k,1270) + lu(k,1272) = lu(k,1272) - lu(k,717) * lu(k,1270) + lu(k,1273) = lu(k,1273) - lu(k,718) * lu(k,1270) + lu(k,1275) = - lu(k,719) * lu(k,1270) + lu(k,1276) = lu(k,1276) - lu(k,720) * lu(k,1270) + lu(k,1277) = lu(k,1277) - lu(k,721) * lu(k,1270) + lu(k,1278) = lu(k,1278) - lu(k,722) * lu(k,1270) + lu(k,1280) = lu(k,1280) - lu(k,723) * lu(k,1270) + lu(k,1281) = lu(k,1281) - lu(k,724) * lu(k,1270) + lu(k,1282) = lu(k,1282) - lu(k,725) * lu(k,1270) + lu(k,1283) = lu(k,1283) - lu(k,726) * lu(k,1270) + lu(k,1284) = lu(k,1284) - lu(k,727) * lu(k,1270) + lu(k,1286) = lu(k,1286) - lu(k,728) * lu(k,1270) + lu(k,1287) = lu(k,1287) - lu(k,729) * lu(k,1270) + lu(k,753) = 1._r8 / lu(k,753) + lu(k,754) = lu(k,754) * lu(k,753) + lu(k,755) = lu(k,755) * lu(k,753) + lu(k,756) = lu(k,756) * lu(k,753) + lu(k,757) = lu(k,757) * lu(k,753) + lu(k,758) = lu(k,758) * lu(k,753) + lu(k,759) = lu(k,759) * lu(k,753) + lu(k,760) = lu(k,760) * lu(k,753) + lu(k,761) = lu(k,761) * lu(k,753) + lu(k,762) = lu(k,762) * lu(k,753) + lu(k,763) = lu(k,763) * lu(k,753) + lu(k,764) = lu(k,764) * lu(k,753) + lu(k,765) = lu(k,765) * lu(k,753) + lu(k,766) = lu(k,766) * lu(k,753) + lu(k,767) = lu(k,767) * lu(k,753) + lu(k,852) = lu(k,852) - lu(k,754) * lu(k,851) + lu(k,853) = lu(k,853) - lu(k,755) * lu(k,851) + lu(k,855) = lu(k,855) - lu(k,756) * lu(k,851) + lu(k,856) = lu(k,856) - lu(k,757) * lu(k,851) + lu(k,857) = lu(k,857) - lu(k,758) * lu(k,851) + lu(k,858) = lu(k,858) - lu(k,759) * lu(k,851) + lu(k,860) = lu(k,860) - lu(k,760) * lu(k,851) + lu(k,861) = lu(k,861) - lu(k,761) * lu(k,851) + lu(k,862) = lu(k,862) - lu(k,762) * lu(k,851) + lu(k,863) = lu(k,863) - lu(k,763) * lu(k,851) + lu(k,864) = lu(k,864) - lu(k,764) * lu(k,851) + lu(k,865) = lu(k,865) - lu(k,765) * lu(k,851) + lu(k,866) = lu(k,866) - lu(k,766) * lu(k,851) + lu(k,867) = lu(k,867) - lu(k,767) * lu(k,851) + lu(k,937) = lu(k,937) - lu(k,754) * lu(k,936) + lu(k,938) = lu(k,938) - lu(k,755) * lu(k,936) + lu(k,940) = lu(k,940) - lu(k,756) * lu(k,936) + lu(k,941) = lu(k,941) - lu(k,757) * lu(k,936) + lu(k,942) = lu(k,942) - lu(k,758) * lu(k,936) + lu(k,943) = lu(k,943) - lu(k,759) * lu(k,936) + lu(k,945) = lu(k,945) - lu(k,760) * lu(k,936) + lu(k,946) = lu(k,946) - lu(k,761) * lu(k,936) + lu(k,947) = lu(k,947) - lu(k,762) * lu(k,936) + lu(k,948) = lu(k,948) - lu(k,763) * lu(k,936) + lu(k,949) = lu(k,949) - lu(k,764) * lu(k,936) + lu(k,950) = lu(k,950) - lu(k,765) * lu(k,936) + lu(k,951) = lu(k,951) - lu(k,766) * lu(k,936) + lu(k,952) = lu(k,952) - lu(k,767) * lu(k,936) + lu(k,1003) = lu(k,1003) - lu(k,754) * lu(k,1002) + lu(k,1004) = lu(k,1004) - lu(k,755) * lu(k,1002) + lu(k,1006) = lu(k,1006) - lu(k,756) * lu(k,1002) + lu(k,1007) = lu(k,1007) - lu(k,757) * lu(k,1002) + lu(k,1008) = lu(k,1008) - lu(k,758) * lu(k,1002) + lu(k,1009) = lu(k,1009) - lu(k,759) * lu(k,1002) + lu(k,1011) = lu(k,1011) - lu(k,760) * lu(k,1002) + lu(k,1012) = lu(k,1012) - lu(k,761) * lu(k,1002) + lu(k,1013) = lu(k,1013) - lu(k,762) * lu(k,1002) + lu(k,1014) = lu(k,1014) - lu(k,763) * lu(k,1002) + lu(k,1015) = lu(k,1015) - lu(k,764) * lu(k,1002) + lu(k,1016) = lu(k,1016) - lu(k,765) * lu(k,1002) + lu(k,1017) = lu(k,1017) - lu(k,766) * lu(k,1002) + lu(k,1018) = lu(k,1018) - lu(k,767) * lu(k,1002) + lu(k,1039) = lu(k,1039) - lu(k,754) * lu(k,1038) + lu(k,1040) = lu(k,1040) - lu(k,755) * lu(k,1038) + lu(k,1042) = lu(k,1042) - lu(k,756) * lu(k,1038) + lu(k,1043) = lu(k,1043) - lu(k,757) * lu(k,1038) + lu(k,1044) = lu(k,1044) - lu(k,758) * lu(k,1038) + lu(k,1045) = lu(k,1045) - lu(k,759) * lu(k,1038) + lu(k,1047) = lu(k,1047) - lu(k,760) * lu(k,1038) + lu(k,1048) = lu(k,1048) - lu(k,761) * lu(k,1038) + lu(k,1049) = lu(k,1049) - lu(k,762) * lu(k,1038) + lu(k,1050) = lu(k,1050) - lu(k,763) * lu(k,1038) + lu(k,1051) = lu(k,1051) - lu(k,764) * lu(k,1038) + lu(k,1052) = lu(k,1052) - lu(k,765) * lu(k,1038) + lu(k,1053) = lu(k,1053) - lu(k,766) * lu(k,1038) + lu(k,1054) = lu(k,1054) - lu(k,767) * lu(k,1038) + lu(k,1076) = lu(k,1076) - lu(k,754) * lu(k,1075) + lu(k,1077) = lu(k,1077) - lu(k,755) * lu(k,1075) + lu(k,1079) = lu(k,1079) - lu(k,756) * lu(k,1075) + lu(k,1080) = lu(k,1080) - lu(k,757) * lu(k,1075) + lu(k,1081) = lu(k,1081) - lu(k,758) * lu(k,1075) + lu(k,1082) = lu(k,1082) - lu(k,759) * lu(k,1075) + lu(k,1084) = lu(k,1084) - lu(k,760) * lu(k,1075) + lu(k,1085) = - lu(k,761) * lu(k,1075) + lu(k,1086) = lu(k,1086) - lu(k,762) * lu(k,1075) + lu(k,1087) = lu(k,1087) - lu(k,763) * lu(k,1075) + lu(k,1088) = - lu(k,764) * lu(k,1075) + lu(k,1089) = lu(k,1089) - lu(k,765) * lu(k,1075) + lu(k,1090) = lu(k,1090) - lu(k,766) * lu(k,1075) + lu(k,1091) = lu(k,1091) - lu(k,767) * lu(k,1075) + lu(k,1161) = lu(k,1161) - lu(k,754) * lu(k,1160) + lu(k,1162) = lu(k,1162) - lu(k,755) * lu(k,1160) + lu(k,1164) = lu(k,1164) - lu(k,756) * lu(k,1160) + lu(k,1165) = lu(k,1165) - lu(k,757) * lu(k,1160) + lu(k,1166) = lu(k,1166) - lu(k,758) * lu(k,1160) + lu(k,1167) = lu(k,1167) - lu(k,759) * lu(k,1160) + lu(k,1169) = lu(k,1169) - lu(k,760) * lu(k,1160) + lu(k,1170) = lu(k,1170) - lu(k,761) * lu(k,1160) + lu(k,1171) = lu(k,1171) - lu(k,762) * lu(k,1160) + lu(k,1172) = lu(k,1172) - lu(k,763) * lu(k,1160) + lu(k,1173) = lu(k,1173) - lu(k,764) * lu(k,1160) + lu(k,1174) = lu(k,1174) - lu(k,765) * lu(k,1160) + lu(k,1175) = lu(k,1175) - lu(k,766) * lu(k,1160) + lu(k,1176) = lu(k,1176) - lu(k,767) * lu(k,1160) + lu(k,1205) = lu(k,1205) - lu(k,754) * lu(k,1204) + lu(k,1206) = lu(k,1206) - lu(k,755) * lu(k,1204) + lu(k,1208) = lu(k,1208) - lu(k,756) * lu(k,1204) + lu(k,1209) = lu(k,1209) - lu(k,757) * lu(k,1204) + lu(k,1210) = lu(k,1210) - lu(k,758) * lu(k,1204) + lu(k,1211) = lu(k,1211) - lu(k,759) * lu(k,1204) + lu(k,1213) = lu(k,1213) - lu(k,760) * lu(k,1204) + lu(k,1214) = lu(k,1214) - lu(k,761) * lu(k,1204) + lu(k,1215) = lu(k,1215) - lu(k,762) * lu(k,1204) + lu(k,1216) = lu(k,1216) - lu(k,763) * lu(k,1204) + lu(k,1217) = lu(k,1217) - lu(k,764) * lu(k,1204) + lu(k,1218) = lu(k,1218) - lu(k,765) * lu(k,1204) + lu(k,1219) = lu(k,1219) - lu(k,766) * lu(k,1204) + lu(k,1220) = lu(k,1220) - lu(k,767) * lu(k,1204) + lu(k,1230) = lu(k,1230) - lu(k,754) * lu(k,1229) + lu(k,1231) = lu(k,1231) - lu(k,755) * lu(k,1229) + lu(k,1233) = lu(k,1233) - lu(k,756) * lu(k,1229) + lu(k,1234) = lu(k,1234) - lu(k,757) * lu(k,1229) + lu(k,1235) = lu(k,1235) - lu(k,758) * lu(k,1229) + lu(k,1236) = lu(k,1236) - lu(k,759) * lu(k,1229) + lu(k,1238) = lu(k,1238) - lu(k,760) * lu(k,1229) + lu(k,1239) = lu(k,1239) - lu(k,761) * lu(k,1229) + lu(k,1240) = - lu(k,762) * lu(k,1229) + lu(k,1241) = lu(k,1241) - lu(k,763) * lu(k,1229) + lu(k,1242) = lu(k,1242) - lu(k,764) * lu(k,1229) + lu(k,1243) = lu(k,1243) - lu(k,765) * lu(k,1229) + lu(k,1244) = lu(k,1244) - lu(k,766) * lu(k,1229) + lu(k,1245) = lu(k,1245) - lu(k,767) * lu(k,1229) + lu(k,1272) = lu(k,1272) - lu(k,754) * lu(k,1271) + lu(k,1273) = lu(k,1273) - lu(k,755) * lu(k,1271) + lu(k,1275) = lu(k,1275) - lu(k,756) * lu(k,1271) + lu(k,1276) = lu(k,1276) - lu(k,757) * lu(k,1271) + lu(k,1277) = lu(k,1277) - lu(k,758) * lu(k,1271) + lu(k,1278) = lu(k,1278) - lu(k,759) * lu(k,1271) + lu(k,1280) = lu(k,1280) - lu(k,760) * lu(k,1271) + lu(k,1281) = lu(k,1281) - lu(k,761) * lu(k,1271) + lu(k,1282) = lu(k,1282) - lu(k,762) * lu(k,1271) + lu(k,1283) = lu(k,1283) - lu(k,763) * lu(k,1271) + lu(k,1284) = lu(k,1284) - lu(k,764) * lu(k,1271) + lu(k,1285) = lu(k,1285) - lu(k,765) * lu(k,1271) + lu(k,1286) = lu(k,1286) - lu(k,766) * lu(k,1271) + lu(k,1287) = lu(k,1287) - lu(k,767) * lu(k,1271) + lu(k,769) = 1._r8 / lu(k,769) + lu(k,770) = lu(k,770) * lu(k,769) + lu(k,771) = lu(k,771) * lu(k,769) + lu(k,772) = lu(k,772) * lu(k,769) + lu(k,773) = lu(k,773) * lu(k,769) + lu(k,774) = lu(k,774) * lu(k,769) + lu(k,775) = lu(k,775) * lu(k,769) + lu(k,776) = lu(k,776) * lu(k,769) + lu(k,777) = lu(k,777) * lu(k,769) + lu(k,785) = lu(k,785) - lu(k,770) * lu(k,782) + lu(k,786) = lu(k,786) - lu(k,771) * lu(k,782) + lu(k,787) = lu(k,787) - lu(k,772) * lu(k,782) + lu(k,788) = lu(k,788) - lu(k,773) * lu(k,782) + lu(k,790) = - lu(k,774) * lu(k,782) + lu(k,792) = lu(k,792) - lu(k,775) * lu(k,782) + lu(k,793) = lu(k,793) - lu(k,776) * lu(k,782) + lu(k,795) = lu(k,795) - lu(k,777) * lu(k,782) + lu(k,801) = - lu(k,770) * lu(k,798) + lu(k,802) = - lu(k,771) * lu(k,798) + lu(k,803) = lu(k,803) - lu(k,772) * lu(k,798) + lu(k,804) = lu(k,804) - lu(k,773) * lu(k,798) + lu(k,806) = lu(k,806) - lu(k,774) * lu(k,798) + lu(k,808) = lu(k,808) - lu(k,775) * lu(k,798) + lu(k,809) = lu(k,809) - lu(k,776) * lu(k,798) + lu(k,811) = lu(k,811) - lu(k,777) * lu(k,798) + lu(k,820) = lu(k,820) - lu(k,770) * lu(k,818) + lu(k,821) = lu(k,821) - lu(k,771) * lu(k,818) + lu(k,822) = lu(k,822) - lu(k,772) * lu(k,818) + lu(k,823) = - lu(k,773) * lu(k,818) + lu(k,825) = - lu(k,774) * lu(k,818) + lu(k,827) = lu(k,827) - lu(k,775) * lu(k,818) + lu(k,828) = lu(k,828) - lu(k,776) * lu(k,818) + lu(k,831) = lu(k,831) - lu(k,777) * lu(k,818) + lu(k,855) = lu(k,855) - lu(k,770) * lu(k,852) + lu(k,856) = lu(k,856) - lu(k,771) * lu(k,852) + lu(k,857) = lu(k,857) - lu(k,772) * lu(k,852) + lu(k,858) = lu(k,858) - lu(k,773) * lu(k,852) + lu(k,860) = lu(k,860) - lu(k,774) * lu(k,852) + lu(k,862) = lu(k,862) - lu(k,775) * lu(k,852) + lu(k,863) = lu(k,863) - lu(k,776) * lu(k,852) + lu(k,867) = lu(k,867) - lu(k,777) * lu(k,852) + lu(k,884) = lu(k,884) - lu(k,770) * lu(k,881) + lu(k,885) = lu(k,885) - lu(k,771) * lu(k,881) + lu(k,886) = lu(k,886) - lu(k,772) * lu(k,881) + lu(k,887) = lu(k,887) - lu(k,773) * lu(k,881) + lu(k,889) = lu(k,889) - lu(k,774) * lu(k,881) + lu(k,891) = lu(k,891) - lu(k,775) * lu(k,881) + lu(k,892) = lu(k,892) - lu(k,776) * lu(k,881) + lu(k,896) = lu(k,896) - lu(k,777) * lu(k,881) + lu(k,940) = lu(k,940) - lu(k,770) * lu(k,937) + lu(k,941) = lu(k,941) - lu(k,771) * lu(k,937) + lu(k,942) = lu(k,942) - lu(k,772) * lu(k,937) + lu(k,943) = lu(k,943) - lu(k,773) * lu(k,937) + lu(k,945) = lu(k,945) - lu(k,774) * lu(k,937) + lu(k,947) = lu(k,947) - lu(k,775) * lu(k,937) + lu(k,948) = lu(k,948) - lu(k,776) * lu(k,937) + lu(k,952) = lu(k,952) - lu(k,777) * lu(k,937) + lu(k,962) = lu(k,962) - lu(k,770) * lu(k,960) + lu(k,963) = lu(k,963) - lu(k,771) * lu(k,960) + lu(k,964) = lu(k,964) - lu(k,772) * lu(k,960) + lu(k,965) = lu(k,965) - lu(k,773) * lu(k,960) + lu(k,967) = lu(k,967) - lu(k,774) * lu(k,960) + lu(k,969) = - lu(k,775) * lu(k,960) + lu(k,970) = lu(k,970) - lu(k,776) * lu(k,960) + lu(k,974) = lu(k,974) - lu(k,777) * lu(k,960) + lu(k,1006) = lu(k,1006) - lu(k,770) * lu(k,1003) + lu(k,1007) = lu(k,1007) - lu(k,771) * lu(k,1003) + lu(k,1008) = lu(k,1008) - lu(k,772) * lu(k,1003) + lu(k,1009) = lu(k,1009) - lu(k,773) * lu(k,1003) + lu(k,1011) = lu(k,1011) - lu(k,774) * lu(k,1003) + lu(k,1013) = lu(k,1013) - lu(k,775) * lu(k,1003) + lu(k,1014) = lu(k,1014) - lu(k,776) * lu(k,1003) + lu(k,1018) = lu(k,1018) - lu(k,777) * lu(k,1003) + lu(k,1042) = lu(k,1042) - lu(k,770) * lu(k,1039) + lu(k,1043) = lu(k,1043) - lu(k,771) * lu(k,1039) + lu(k,1044) = lu(k,1044) - lu(k,772) * lu(k,1039) + lu(k,1045) = lu(k,1045) - lu(k,773) * lu(k,1039) + lu(k,1047) = lu(k,1047) - lu(k,774) * lu(k,1039) + lu(k,1049) = lu(k,1049) - lu(k,775) * lu(k,1039) + lu(k,1050) = lu(k,1050) - lu(k,776) * lu(k,1039) + lu(k,1054) = lu(k,1054) - lu(k,777) * lu(k,1039) + lu(k,1079) = lu(k,1079) - lu(k,770) * lu(k,1076) + lu(k,1080) = lu(k,1080) - lu(k,771) * lu(k,1076) + lu(k,1081) = lu(k,1081) - lu(k,772) * lu(k,1076) + lu(k,1082) = lu(k,1082) - lu(k,773) * lu(k,1076) + lu(k,1084) = lu(k,1084) - lu(k,774) * lu(k,1076) + lu(k,1086) = lu(k,1086) - lu(k,775) * lu(k,1076) + lu(k,1087) = lu(k,1087) - lu(k,776) * lu(k,1076) + lu(k,1091) = lu(k,1091) - lu(k,777) * lu(k,1076) + lu(k,1164) = lu(k,1164) - lu(k,770) * lu(k,1161) + lu(k,1165) = lu(k,1165) - lu(k,771) * lu(k,1161) + lu(k,1166) = lu(k,1166) - lu(k,772) * lu(k,1161) + lu(k,1167) = lu(k,1167) - lu(k,773) * lu(k,1161) + lu(k,1169) = lu(k,1169) - lu(k,774) * lu(k,1161) + lu(k,1171) = lu(k,1171) - lu(k,775) * lu(k,1161) + lu(k,1172) = lu(k,1172) - lu(k,776) * lu(k,1161) + lu(k,1176) = lu(k,1176) - lu(k,777) * lu(k,1161) + lu(k,1208) = lu(k,1208) - lu(k,770) * lu(k,1205) + lu(k,1209) = lu(k,1209) - lu(k,771) * lu(k,1205) + lu(k,1210) = lu(k,1210) - lu(k,772) * lu(k,1205) + lu(k,1211) = lu(k,1211) - lu(k,773) * lu(k,1205) + lu(k,1213) = lu(k,1213) - lu(k,774) * lu(k,1205) + lu(k,1215) = lu(k,1215) - lu(k,775) * lu(k,1205) + lu(k,1216) = lu(k,1216) - lu(k,776) * lu(k,1205) + lu(k,1220) = lu(k,1220) - lu(k,777) * lu(k,1205) + lu(k,1233) = lu(k,1233) - lu(k,770) * lu(k,1230) + lu(k,1234) = lu(k,1234) - lu(k,771) * lu(k,1230) + lu(k,1235) = lu(k,1235) - lu(k,772) * lu(k,1230) + lu(k,1236) = lu(k,1236) - lu(k,773) * lu(k,1230) + lu(k,1238) = lu(k,1238) - lu(k,774) * lu(k,1230) + lu(k,1240) = lu(k,1240) - lu(k,775) * lu(k,1230) + lu(k,1241) = lu(k,1241) - lu(k,776) * lu(k,1230) + lu(k,1245) = lu(k,1245) - lu(k,777) * lu(k,1230) + lu(k,1275) = lu(k,1275) - lu(k,770) * lu(k,1272) + lu(k,1276) = lu(k,1276) - lu(k,771) * lu(k,1272) + lu(k,1277) = lu(k,1277) - lu(k,772) * lu(k,1272) + lu(k,1278) = lu(k,1278) - lu(k,773) * lu(k,1272) + lu(k,1280) = lu(k,1280) - lu(k,774) * lu(k,1272) + lu(k,1282) = lu(k,1282) - lu(k,775) * lu(k,1272) + lu(k,1283) = lu(k,1283) - lu(k,776) * lu(k,1272) + lu(k,1287) = lu(k,1287) - lu(k,777) * lu(k,1272) + lu(k,1295) = lu(k,1295) - lu(k,770) * lu(k,1293) + lu(k,1296) = lu(k,1296) - lu(k,771) * lu(k,1293) + lu(k,1297) = lu(k,1297) - lu(k,772) * lu(k,1293) + lu(k,1298) = lu(k,1298) - lu(k,773) * lu(k,1293) + lu(k,1300) = lu(k,1300) - lu(k,774) * lu(k,1293) + lu(k,1302) = lu(k,1302) - lu(k,775) * lu(k,1293) + lu(k,1303) = lu(k,1303) - lu(k,776) * lu(k,1293) + lu(k,1307) = lu(k,1307) - lu(k,777) * lu(k,1293) + end do + end subroutine lu_fac15 + subroutine lu_fac16( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,783) = 1._r8 / lu(k,783) + lu(k,784) = lu(k,784) * lu(k,783) + lu(k,785) = lu(k,785) * lu(k,783) + lu(k,786) = lu(k,786) * lu(k,783) + lu(k,787) = lu(k,787) * lu(k,783) + lu(k,788) = lu(k,788) * lu(k,783) + lu(k,789) = lu(k,789) * lu(k,783) + lu(k,790) = lu(k,790) * lu(k,783) + lu(k,791) = lu(k,791) * lu(k,783) + lu(k,792) = lu(k,792) * lu(k,783) + lu(k,793) = lu(k,793) * lu(k,783) + lu(k,794) = lu(k,794) * lu(k,783) + lu(k,795) = lu(k,795) * lu(k,783) + lu(k,800) = lu(k,800) - lu(k,784) * lu(k,799) + lu(k,801) = lu(k,801) - lu(k,785) * lu(k,799) + lu(k,802) = lu(k,802) - lu(k,786) * lu(k,799) + lu(k,803) = lu(k,803) - lu(k,787) * lu(k,799) + lu(k,804) = lu(k,804) - lu(k,788) * lu(k,799) + lu(k,805) = lu(k,805) - lu(k,789) * lu(k,799) + lu(k,806) = lu(k,806) - lu(k,790) * lu(k,799) + lu(k,807) = - lu(k,791) * lu(k,799) + lu(k,808) = lu(k,808) - lu(k,792) * lu(k,799) + lu(k,809) = lu(k,809) - lu(k,793) * lu(k,799) + lu(k,810) = - lu(k,794) * lu(k,799) + lu(k,811) = lu(k,811) - lu(k,795) * lu(k,799) + lu(k,854) = lu(k,854) - lu(k,784) * lu(k,853) + lu(k,855) = lu(k,855) - lu(k,785) * lu(k,853) + lu(k,856) = lu(k,856) - lu(k,786) * lu(k,853) + lu(k,857) = lu(k,857) - lu(k,787) * lu(k,853) + lu(k,858) = lu(k,858) - lu(k,788) * lu(k,853) + lu(k,859) = - lu(k,789) * lu(k,853) + lu(k,860) = lu(k,860) - lu(k,790) * lu(k,853) + lu(k,861) = lu(k,861) - lu(k,791) * lu(k,853) + lu(k,862) = lu(k,862) - lu(k,792) * lu(k,853) + lu(k,863) = lu(k,863) - lu(k,793) * lu(k,853) + lu(k,864) = lu(k,864) - lu(k,794) * lu(k,853) + lu(k,867) = lu(k,867) - lu(k,795) * lu(k,853) + lu(k,883) = lu(k,883) - lu(k,784) * lu(k,882) + lu(k,884) = lu(k,884) - lu(k,785) * lu(k,882) + lu(k,885) = lu(k,885) - lu(k,786) * lu(k,882) + lu(k,886) = lu(k,886) - lu(k,787) * lu(k,882) + lu(k,887) = lu(k,887) - lu(k,788) * lu(k,882) + lu(k,888) = lu(k,888) - lu(k,789) * lu(k,882) + lu(k,889) = lu(k,889) - lu(k,790) * lu(k,882) + lu(k,890) = lu(k,890) - lu(k,791) * lu(k,882) + lu(k,891) = lu(k,891) - lu(k,792) * lu(k,882) + lu(k,892) = lu(k,892) - lu(k,793) * lu(k,882) + lu(k,893) = lu(k,893) - lu(k,794) * lu(k,882) + lu(k,896) = lu(k,896) - lu(k,795) * lu(k,882) + lu(k,939) = lu(k,939) - lu(k,784) * lu(k,938) + lu(k,940) = lu(k,940) - lu(k,785) * lu(k,938) + lu(k,941) = lu(k,941) - lu(k,786) * lu(k,938) + lu(k,942) = lu(k,942) - lu(k,787) * lu(k,938) + lu(k,943) = lu(k,943) - lu(k,788) * lu(k,938) + lu(k,944) = lu(k,944) - lu(k,789) * lu(k,938) + lu(k,945) = lu(k,945) - lu(k,790) * lu(k,938) + lu(k,946) = lu(k,946) - lu(k,791) * lu(k,938) + lu(k,947) = lu(k,947) - lu(k,792) * lu(k,938) + lu(k,948) = lu(k,948) - lu(k,793) * lu(k,938) + lu(k,949) = lu(k,949) - lu(k,794) * lu(k,938) + lu(k,952) = lu(k,952) - lu(k,795) * lu(k,938) + lu(k,1005) = lu(k,1005) - lu(k,784) * lu(k,1004) + lu(k,1006) = lu(k,1006) - lu(k,785) * lu(k,1004) + lu(k,1007) = lu(k,1007) - lu(k,786) * lu(k,1004) + lu(k,1008) = lu(k,1008) - lu(k,787) * lu(k,1004) + lu(k,1009) = lu(k,1009) - lu(k,788) * lu(k,1004) + lu(k,1010) = lu(k,1010) - lu(k,789) * lu(k,1004) + lu(k,1011) = lu(k,1011) - lu(k,790) * lu(k,1004) + lu(k,1012) = lu(k,1012) - lu(k,791) * lu(k,1004) + lu(k,1013) = lu(k,1013) - lu(k,792) * lu(k,1004) + lu(k,1014) = lu(k,1014) - lu(k,793) * lu(k,1004) + lu(k,1015) = lu(k,1015) - lu(k,794) * lu(k,1004) + lu(k,1018) = lu(k,1018) - lu(k,795) * lu(k,1004) + lu(k,1041) = lu(k,1041) - lu(k,784) * lu(k,1040) + lu(k,1042) = lu(k,1042) - lu(k,785) * lu(k,1040) + lu(k,1043) = lu(k,1043) - lu(k,786) * lu(k,1040) + lu(k,1044) = lu(k,1044) - lu(k,787) * lu(k,1040) + lu(k,1045) = lu(k,1045) - lu(k,788) * lu(k,1040) + lu(k,1046) = lu(k,1046) - lu(k,789) * lu(k,1040) + lu(k,1047) = lu(k,1047) - lu(k,790) * lu(k,1040) + lu(k,1048) = lu(k,1048) - lu(k,791) * lu(k,1040) + lu(k,1049) = lu(k,1049) - lu(k,792) * lu(k,1040) + lu(k,1050) = lu(k,1050) - lu(k,793) * lu(k,1040) + lu(k,1051) = lu(k,1051) - lu(k,794) * lu(k,1040) + lu(k,1054) = lu(k,1054) - lu(k,795) * lu(k,1040) + lu(k,1078) = lu(k,1078) - lu(k,784) * lu(k,1077) + lu(k,1079) = lu(k,1079) - lu(k,785) * lu(k,1077) + lu(k,1080) = lu(k,1080) - lu(k,786) * lu(k,1077) + lu(k,1081) = lu(k,1081) - lu(k,787) * lu(k,1077) + lu(k,1082) = lu(k,1082) - lu(k,788) * lu(k,1077) + lu(k,1083) = lu(k,1083) - lu(k,789) * lu(k,1077) + lu(k,1084) = lu(k,1084) - lu(k,790) * lu(k,1077) + lu(k,1085) = lu(k,1085) - lu(k,791) * lu(k,1077) + lu(k,1086) = lu(k,1086) - lu(k,792) * lu(k,1077) + lu(k,1087) = lu(k,1087) - lu(k,793) * lu(k,1077) + lu(k,1088) = lu(k,1088) - lu(k,794) * lu(k,1077) + lu(k,1091) = lu(k,1091) - lu(k,795) * lu(k,1077) + lu(k,1163) = lu(k,1163) - lu(k,784) * lu(k,1162) + lu(k,1164) = lu(k,1164) - lu(k,785) * lu(k,1162) + lu(k,1165) = lu(k,1165) - lu(k,786) * lu(k,1162) + lu(k,1166) = lu(k,1166) - lu(k,787) * lu(k,1162) + lu(k,1167) = lu(k,1167) - lu(k,788) * lu(k,1162) + lu(k,1168) = lu(k,1168) - lu(k,789) * lu(k,1162) + lu(k,1169) = lu(k,1169) - lu(k,790) * lu(k,1162) + lu(k,1170) = lu(k,1170) - lu(k,791) * lu(k,1162) + lu(k,1171) = lu(k,1171) - lu(k,792) * lu(k,1162) + lu(k,1172) = lu(k,1172) - lu(k,793) * lu(k,1162) + lu(k,1173) = lu(k,1173) - lu(k,794) * lu(k,1162) + lu(k,1176) = lu(k,1176) - lu(k,795) * lu(k,1162) + lu(k,1207) = lu(k,1207) - lu(k,784) * lu(k,1206) + lu(k,1208) = lu(k,1208) - lu(k,785) * lu(k,1206) + lu(k,1209) = lu(k,1209) - lu(k,786) * lu(k,1206) + lu(k,1210) = lu(k,1210) - lu(k,787) * lu(k,1206) + lu(k,1211) = lu(k,1211) - lu(k,788) * lu(k,1206) + lu(k,1212) = lu(k,1212) - lu(k,789) * lu(k,1206) + lu(k,1213) = lu(k,1213) - lu(k,790) * lu(k,1206) + lu(k,1214) = lu(k,1214) - lu(k,791) * lu(k,1206) + lu(k,1215) = lu(k,1215) - lu(k,792) * lu(k,1206) + lu(k,1216) = lu(k,1216) - lu(k,793) * lu(k,1206) + lu(k,1217) = lu(k,1217) - lu(k,794) * lu(k,1206) + lu(k,1220) = lu(k,1220) - lu(k,795) * lu(k,1206) + lu(k,1232) = lu(k,1232) - lu(k,784) * lu(k,1231) + lu(k,1233) = lu(k,1233) - lu(k,785) * lu(k,1231) + lu(k,1234) = lu(k,1234) - lu(k,786) * lu(k,1231) + lu(k,1235) = lu(k,1235) - lu(k,787) * lu(k,1231) + lu(k,1236) = lu(k,1236) - lu(k,788) * lu(k,1231) + lu(k,1237) = lu(k,1237) - lu(k,789) * lu(k,1231) + lu(k,1238) = lu(k,1238) - lu(k,790) * lu(k,1231) + lu(k,1239) = lu(k,1239) - lu(k,791) * lu(k,1231) + lu(k,1240) = lu(k,1240) - lu(k,792) * lu(k,1231) + lu(k,1241) = lu(k,1241) - lu(k,793) * lu(k,1231) + lu(k,1242) = lu(k,1242) - lu(k,794) * lu(k,1231) + lu(k,1245) = lu(k,1245) - lu(k,795) * lu(k,1231) + lu(k,1274) = lu(k,1274) - lu(k,784) * lu(k,1273) + lu(k,1275) = lu(k,1275) - lu(k,785) * lu(k,1273) + lu(k,1276) = lu(k,1276) - lu(k,786) * lu(k,1273) + lu(k,1277) = lu(k,1277) - lu(k,787) * lu(k,1273) + lu(k,1278) = lu(k,1278) - lu(k,788) * lu(k,1273) + lu(k,1279) = lu(k,1279) - lu(k,789) * lu(k,1273) + lu(k,1280) = lu(k,1280) - lu(k,790) * lu(k,1273) + lu(k,1281) = lu(k,1281) - lu(k,791) * lu(k,1273) + lu(k,1282) = lu(k,1282) - lu(k,792) * lu(k,1273) + lu(k,1283) = lu(k,1283) - lu(k,793) * lu(k,1273) + lu(k,1284) = lu(k,1284) - lu(k,794) * lu(k,1273) + lu(k,1287) = lu(k,1287) - lu(k,795) * lu(k,1273) + lu(k,800) = 1._r8 / lu(k,800) + lu(k,801) = lu(k,801) * lu(k,800) + lu(k,802) = lu(k,802) * lu(k,800) + lu(k,803) = lu(k,803) * lu(k,800) + lu(k,804) = lu(k,804) * lu(k,800) + lu(k,805) = lu(k,805) * lu(k,800) + lu(k,806) = lu(k,806) * lu(k,800) + lu(k,807) = lu(k,807) * lu(k,800) + lu(k,808) = lu(k,808) * lu(k,800) + lu(k,809) = lu(k,809) * lu(k,800) + lu(k,810) = lu(k,810) * lu(k,800) + lu(k,811) = lu(k,811) * lu(k,800) + lu(k,820) = lu(k,820) - lu(k,801) * lu(k,819) + lu(k,821) = lu(k,821) - lu(k,802) * lu(k,819) + lu(k,822) = lu(k,822) - lu(k,803) * lu(k,819) + lu(k,823) = lu(k,823) - lu(k,804) * lu(k,819) + lu(k,824) = lu(k,824) - lu(k,805) * lu(k,819) + lu(k,825) = lu(k,825) - lu(k,806) * lu(k,819) + lu(k,826) = lu(k,826) - lu(k,807) * lu(k,819) + lu(k,827) = lu(k,827) - lu(k,808) * lu(k,819) + lu(k,828) = lu(k,828) - lu(k,809) * lu(k,819) + lu(k,829) = lu(k,829) - lu(k,810) * lu(k,819) + lu(k,831) = lu(k,831) - lu(k,811) * lu(k,819) + lu(k,855) = lu(k,855) - lu(k,801) * lu(k,854) + lu(k,856) = lu(k,856) - lu(k,802) * lu(k,854) + lu(k,857) = lu(k,857) - lu(k,803) * lu(k,854) + lu(k,858) = lu(k,858) - lu(k,804) * lu(k,854) + lu(k,859) = lu(k,859) - lu(k,805) * lu(k,854) + lu(k,860) = lu(k,860) - lu(k,806) * lu(k,854) + lu(k,861) = lu(k,861) - lu(k,807) * lu(k,854) + lu(k,862) = lu(k,862) - lu(k,808) * lu(k,854) + lu(k,863) = lu(k,863) - lu(k,809) * lu(k,854) + lu(k,864) = lu(k,864) - lu(k,810) * lu(k,854) + lu(k,867) = lu(k,867) - lu(k,811) * lu(k,854) + lu(k,884) = lu(k,884) - lu(k,801) * lu(k,883) + lu(k,885) = lu(k,885) - lu(k,802) * lu(k,883) + lu(k,886) = lu(k,886) - lu(k,803) * lu(k,883) + lu(k,887) = lu(k,887) - lu(k,804) * lu(k,883) + lu(k,888) = lu(k,888) - lu(k,805) * lu(k,883) + lu(k,889) = lu(k,889) - lu(k,806) * lu(k,883) + lu(k,890) = lu(k,890) - lu(k,807) * lu(k,883) + lu(k,891) = lu(k,891) - lu(k,808) * lu(k,883) + lu(k,892) = lu(k,892) - lu(k,809) * lu(k,883) + lu(k,893) = lu(k,893) - lu(k,810) * lu(k,883) + lu(k,896) = lu(k,896) - lu(k,811) * lu(k,883) + lu(k,940) = lu(k,940) - lu(k,801) * lu(k,939) + lu(k,941) = lu(k,941) - lu(k,802) * lu(k,939) + lu(k,942) = lu(k,942) - lu(k,803) * lu(k,939) + lu(k,943) = lu(k,943) - lu(k,804) * lu(k,939) + lu(k,944) = lu(k,944) - lu(k,805) * lu(k,939) + lu(k,945) = lu(k,945) - lu(k,806) * lu(k,939) + lu(k,946) = lu(k,946) - lu(k,807) * lu(k,939) + lu(k,947) = lu(k,947) - lu(k,808) * lu(k,939) + lu(k,948) = lu(k,948) - lu(k,809) * lu(k,939) + lu(k,949) = lu(k,949) - lu(k,810) * lu(k,939) + lu(k,952) = lu(k,952) - lu(k,811) * lu(k,939) + lu(k,962) = lu(k,962) - lu(k,801) * lu(k,961) + lu(k,963) = lu(k,963) - lu(k,802) * lu(k,961) + lu(k,964) = lu(k,964) - lu(k,803) * lu(k,961) + lu(k,965) = lu(k,965) - lu(k,804) * lu(k,961) + lu(k,966) = lu(k,966) - lu(k,805) * lu(k,961) + lu(k,967) = lu(k,967) - lu(k,806) * lu(k,961) + lu(k,968) = lu(k,968) - lu(k,807) * lu(k,961) + lu(k,969) = lu(k,969) - lu(k,808) * lu(k,961) + lu(k,970) = lu(k,970) - lu(k,809) * lu(k,961) + lu(k,971) = lu(k,971) - lu(k,810) * lu(k,961) + lu(k,974) = lu(k,974) - lu(k,811) * lu(k,961) + lu(k,1006) = lu(k,1006) - lu(k,801) * lu(k,1005) + lu(k,1007) = lu(k,1007) - lu(k,802) * lu(k,1005) + lu(k,1008) = lu(k,1008) - lu(k,803) * lu(k,1005) + lu(k,1009) = lu(k,1009) - lu(k,804) * lu(k,1005) + lu(k,1010) = lu(k,1010) - lu(k,805) * lu(k,1005) + lu(k,1011) = lu(k,1011) - lu(k,806) * lu(k,1005) + lu(k,1012) = lu(k,1012) - lu(k,807) * lu(k,1005) + lu(k,1013) = lu(k,1013) - lu(k,808) * lu(k,1005) + lu(k,1014) = lu(k,1014) - lu(k,809) * lu(k,1005) + lu(k,1015) = lu(k,1015) - lu(k,810) * lu(k,1005) + lu(k,1018) = lu(k,1018) - lu(k,811) * lu(k,1005) + lu(k,1042) = lu(k,1042) - lu(k,801) * lu(k,1041) + lu(k,1043) = lu(k,1043) - lu(k,802) * lu(k,1041) + lu(k,1044) = lu(k,1044) - lu(k,803) * lu(k,1041) + lu(k,1045) = lu(k,1045) - lu(k,804) * lu(k,1041) + lu(k,1046) = lu(k,1046) - lu(k,805) * lu(k,1041) + lu(k,1047) = lu(k,1047) - lu(k,806) * lu(k,1041) + lu(k,1048) = lu(k,1048) - lu(k,807) * lu(k,1041) + lu(k,1049) = lu(k,1049) - lu(k,808) * lu(k,1041) + lu(k,1050) = lu(k,1050) - lu(k,809) * lu(k,1041) + lu(k,1051) = lu(k,1051) - lu(k,810) * lu(k,1041) + lu(k,1054) = lu(k,1054) - lu(k,811) * lu(k,1041) + lu(k,1079) = lu(k,1079) - lu(k,801) * lu(k,1078) + lu(k,1080) = lu(k,1080) - lu(k,802) * lu(k,1078) + lu(k,1081) = lu(k,1081) - lu(k,803) * lu(k,1078) + lu(k,1082) = lu(k,1082) - lu(k,804) * lu(k,1078) + lu(k,1083) = lu(k,1083) - lu(k,805) * lu(k,1078) + lu(k,1084) = lu(k,1084) - lu(k,806) * lu(k,1078) + lu(k,1085) = lu(k,1085) - lu(k,807) * lu(k,1078) + lu(k,1086) = lu(k,1086) - lu(k,808) * lu(k,1078) + lu(k,1087) = lu(k,1087) - lu(k,809) * lu(k,1078) + lu(k,1088) = lu(k,1088) - lu(k,810) * lu(k,1078) + lu(k,1091) = lu(k,1091) - lu(k,811) * lu(k,1078) + lu(k,1164) = lu(k,1164) - lu(k,801) * lu(k,1163) + lu(k,1165) = lu(k,1165) - lu(k,802) * lu(k,1163) + lu(k,1166) = lu(k,1166) - lu(k,803) * lu(k,1163) + lu(k,1167) = lu(k,1167) - lu(k,804) * lu(k,1163) + lu(k,1168) = lu(k,1168) - lu(k,805) * lu(k,1163) + lu(k,1169) = lu(k,1169) - lu(k,806) * lu(k,1163) + lu(k,1170) = lu(k,1170) - lu(k,807) * lu(k,1163) + lu(k,1171) = lu(k,1171) - lu(k,808) * lu(k,1163) + lu(k,1172) = lu(k,1172) - lu(k,809) * lu(k,1163) + lu(k,1173) = lu(k,1173) - lu(k,810) * lu(k,1163) + lu(k,1176) = lu(k,1176) - lu(k,811) * lu(k,1163) + lu(k,1208) = lu(k,1208) - lu(k,801) * lu(k,1207) + lu(k,1209) = lu(k,1209) - lu(k,802) * lu(k,1207) + lu(k,1210) = lu(k,1210) - lu(k,803) * lu(k,1207) + lu(k,1211) = lu(k,1211) - lu(k,804) * lu(k,1207) + lu(k,1212) = lu(k,1212) - lu(k,805) * lu(k,1207) + lu(k,1213) = lu(k,1213) - lu(k,806) * lu(k,1207) + lu(k,1214) = lu(k,1214) - lu(k,807) * lu(k,1207) + lu(k,1215) = lu(k,1215) - lu(k,808) * lu(k,1207) + lu(k,1216) = lu(k,1216) - lu(k,809) * lu(k,1207) + lu(k,1217) = lu(k,1217) - lu(k,810) * lu(k,1207) + lu(k,1220) = lu(k,1220) - lu(k,811) * lu(k,1207) + lu(k,1233) = lu(k,1233) - lu(k,801) * lu(k,1232) + lu(k,1234) = lu(k,1234) - lu(k,802) * lu(k,1232) + lu(k,1235) = lu(k,1235) - lu(k,803) * lu(k,1232) + lu(k,1236) = lu(k,1236) - lu(k,804) * lu(k,1232) + lu(k,1237) = lu(k,1237) - lu(k,805) * lu(k,1232) + lu(k,1238) = lu(k,1238) - lu(k,806) * lu(k,1232) + lu(k,1239) = lu(k,1239) - lu(k,807) * lu(k,1232) + lu(k,1240) = lu(k,1240) - lu(k,808) * lu(k,1232) + lu(k,1241) = lu(k,1241) - lu(k,809) * lu(k,1232) + lu(k,1242) = lu(k,1242) - lu(k,810) * lu(k,1232) + lu(k,1245) = lu(k,1245) - lu(k,811) * lu(k,1232) + lu(k,1275) = lu(k,1275) - lu(k,801) * lu(k,1274) + lu(k,1276) = lu(k,1276) - lu(k,802) * lu(k,1274) + lu(k,1277) = lu(k,1277) - lu(k,803) * lu(k,1274) + lu(k,1278) = lu(k,1278) - lu(k,804) * lu(k,1274) + lu(k,1279) = lu(k,1279) - lu(k,805) * lu(k,1274) + lu(k,1280) = lu(k,1280) - lu(k,806) * lu(k,1274) + lu(k,1281) = lu(k,1281) - lu(k,807) * lu(k,1274) + lu(k,1282) = lu(k,1282) - lu(k,808) * lu(k,1274) + lu(k,1283) = lu(k,1283) - lu(k,809) * lu(k,1274) + lu(k,1284) = lu(k,1284) - lu(k,810) * lu(k,1274) + lu(k,1287) = lu(k,1287) - lu(k,811) * lu(k,1274) + lu(k,1295) = lu(k,1295) - lu(k,801) * lu(k,1294) + lu(k,1296) = lu(k,1296) - lu(k,802) * lu(k,1294) + lu(k,1297) = lu(k,1297) - lu(k,803) * lu(k,1294) + lu(k,1298) = lu(k,1298) - lu(k,804) * lu(k,1294) + lu(k,1299) = lu(k,1299) - lu(k,805) * lu(k,1294) + lu(k,1300) = lu(k,1300) - lu(k,806) * lu(k,1294) + lu(k,1301) = lu(k,1301) - lu(k,807) * lu(k,1294) + lu(k,1302) = lu(k,1302) - lu(k,808) * lu(k,1294) + lu(k,1303) = lu(k,1303) - lu(k,809) * lu(k,1294) + lu(k,1304) = - lu(k,810) * lu(k,1294) + lu(k,1307) = lu(k,1307) - lu(k,811) * lu(k,1294) + lu(k,820) = 1._r8 / lu(k,820) + lu(k,821) = lu(k,821) * lu(k,820) + lu(k,822) = lu(k,822) * lu(k,820) + lu(k,823) = lu(k,823) * lu(k,820) + lu(k,824) = lu(k,824) * lu(k,820) + lu(k,825) = lu(k,825) * lu(k,820) + lu(k,826) = lu(k,826) * lu(k,820) + lu(k,827) = lu(k,827) * lu(k,820) + lu(k,828) = lu(k,828) * lu(k,820) + lu(k,829) = lu(k,829) * lu(k,820) + lu(k,830) = lu(k,830) * lu(k,820) + lu(k,831) = lu(k,831) * lu(k,820) + lu(k,856) = lu(k,856) - lu(k,821) * lu(k,855) + lu(k,857) = lu(k,857) - lu(k,822) * lu(k,855) + lu(k,858) = lu(k,858) - lu(k,823) * lu(k,855) + lu(k,859) = lu(k,859) - lu(k,824) * lu(k,855) + lu(k,860) = lu(k,860) - lu(k,825) * lu(k,855) + lu(k,861) = lu(k,861) - lu(k,826) * lu(k,855) + lu(k,862) = lu(k,862) - lu(k,827) * lu(k,855) + lu(k,863) = lu(k,863) - lu(k,828) * lu(k,855) + lu(k,864) = lu(k,864) - lu(k,829) * lu(k,855) + lu(k,865) = lu(k,865) - lu(k,830) * lu(k,855) + lu(k,867) = lu(k,867) - lu(k,831) * lu(k,855) + lu(k,885) = lu(k,885) - lu(k,821) * lu(k,884) + lu(k,886) = lu(k,886) - lu(k,822) * lu(k,884) + lu(k,887) = lu(k,887) - lu(k,823) * lu(k,884) + lu(k,888) = lu(k,888) - lu(k,824) * lu(k,884) + lu(k,889) = lu(k,889) - lu(k,825) * lu(k,884) + lu(k,890) = lu(k,890) - lu(k,826) * lu(k,884) + lu(k,891) = lu(k,891) - lu(k,827) * lu(k,884) + lu(k,892) = lu(k,892) - lu(k,828) * lu(k,884) + lu(k,893) = lu(k,893) - lu(k,829) * lu(k,884) + lu(k,894) = lu(k,894) - lu(k,830) * lu(k,884) + lu(k,896) = lu(k,896) - lu(k,831) * lu(k,884) + lu(k,941) = lu(k,941) - lu(k,821) * lu(k,940) + lu(k,942) = lu(k,942) - lu(k,822) * lu(k,940) + lu(k,943) = lu(k,943) - lu(k,823) * lu(k,940) + lu(k,944) = lu(k,944) - lu(k,824) * lu(k,940) + lu(k,945) = lu(k,945) - lu(k,825) * lu(k,940) + lu(k,946) = lu(k,946) - lu(k,826) * lu(k,940) + lu(k,947) = lu(k,947) - lu(k,827) * lu(k,940) + lu(k,948) = lu(k,948) - lu(k,828) * lu(k,940) + lu(k,949) = lu(k,949) - lu(k,829) * lu(k,940) + lu(k,950) = lu(k,950) - lu(k,830) * lu(k,940) + lu(k,952) = lu(k,952) - lu(k,831) * lu(k,940) + lu(k,963) = lu(k,963) - lu(k,821) * lu(k,962) + lu(k,964) = lu(k,964) - lu(k,822) * lu(k,962) + lu(k,965) = lu(k,965) - lu(k,823) * lu(k,962) + lu(k,966) = lu(k,966) - lu(k,824) * lu(k,962) + lu(k,967) = lu(k,967) - lu(k,825) * lu(k,962) + lu(k,968) = lu(k,968) - lu(k,826) * lu(k,962) + lu(k,969) = lu(k,969) - lu(k,827) * lu(k,962) + lu(k,970) = lu(k,970) - lu(k,828) * lu(k,962) + lu(k,971) = lu(k,971) - lu(k,829) * lu(k,962) + lu(k,972) = lu(k,972) - lu(k,830) * lu(k,962) + lu(k,974) = lu(k,974) - lu(k,831) * lu(k,962) + lu(k,1007) = lu(k,1007) - lu(k,821) * lu(k,1006) + lu(k,1008) = lu(k,1008) - lu(k,822) * lu(k,1006) + lu(k,1009) = lu(k,1009) - lu(k,823) * lu(k,1006) + lu(k,1010) = lu(k,1010) - lu(k,824) * lu(k,1006) + lu(k,1011) = lu(k,1011) - lu(k,825) * lu(k,1006) + lu(k,1012) = lu(k,1012) - lu(k,826) * lu(k,1006) + lu(k,1013) = lu(k,1013) - lu(k,827) * lu(k,1006) + lu(k,1014) = lu(k,1014) - lu(k,828) * lu(k,1006) + lu(k,1015) = lu(k,1015) - lu(k,829) * lu(k,1006) + lu(k,1016) = lu(k,1016) - lu(k,830) * lu(k,1006) + lu(k,1018) = lu(k,1018) - lu(k,831) * lu(k,1006) + lu(k,1043) = lu(k,1043) - lu(k,821) * lu(k,1042) + lu(k,1044) = lu(k,1044) - lu(k,822) * lu(k,1042) + lu(k,1045) = lu(k,1045) - lu(k,823) * lu(k,1042) + lu(k,1046) = lu(k,1046) - lu(k,824) * lu(k,1042) + lu(k,1047) = lu(k,1047) - lu(k,825) * lu(k,1042) + lu(k,1048) = lu(k,1048) - lu(k,826) * lu(k,1042) + lu(k,1049) = lu(k,1049) - lu(k,827) * lu(k,1042) + lu(k,1050) = lu(k,1050) - lu(k,828) * lu(k,1042) + lu(k,1051) = lu(k,1051) - lu(k,829) * lu(k,1042) + lu(k,1052) = lu(k,1052) - lu(k,830) * lu(k,1042) + lu(k,1054) = lu(k,1054) - lu(k,831) * lu(k,1042) + lu(k,1080) = lu(k,1080) - lu(k,821) * lu(k,1079) + lu(k,1081) = lu(k,1081) - lu(k,822) * lu(k,1079) + lu(k,1082) = lu(k,1082) - lu(k,823) * lu(k,1079) + lu(k,1083) = lu(k,1083) - lu(k,824) * lu(k,1079) + lu(k,1084) = lu(k,1084) - lu(k,825) * lu(k,1079) + lu(k,1085) = lu(k,1085) - lu(k,826) * lu(k,1079) + lu(k,1086) = lu(k,1086) - lu(k,827) * lu(k,1079) + lu(k,1087) = lu(k,1087) - lu(k,828) * lu(k,1079) + lu(k,1088) = lu(k,1088) - lu(k,829) * lu(k,1079) + lu(k,1089) = lu(k,1089) - lu(k,830) * lu(k,1079) + lu(k,1091) = lu(k,1091) - lu(k,831) * lu(k,1079) + lu(k,1165) = lu(k,1165) - lu(k,821) * lu(k,1164) + lu(k,1166) = lu(k,1166) - lu(k,822) * lu(k,1164) + lu(k,1167) = lu(k,1167) - lu(k,823) * lu(k,1164) + lu(k,1168) = lu(k,1168) - lu(k,824) * lu(k,1164) + lu(k,1169) = lu(k,1169) - lu(k,825) * lu(k,1164) + lu(k,1170) = lu(k,1170) - lu(k,826) * lu(k,1164) + lu(k,1171) = lu(k,1171) - lu(k,827) * lu(k,1164) + lu(k,1172) = lu(k,1172) - lu(k,828) * lu(k,1164) + lu(k,1173) = lu(k,1173) - lu(k,829) * lu(k,1164) + lu(k,1174) = lu(k,1174) - lu(k,830) * lu(k,1164) + lu(k,1176) = lu(k,1176) - lu(k,831) * lu(k,1164) + lu(k,1209) = lu(k,1209) - lu(k,821) * lu(k,1208) + lu(k,1210) = lu(k,1210) - lu(k,822) * lu(k,1208) + lu(k,1211) = lu(k,1211) - lu(k,823) * lu(k,1208) + lu(k,1212) = lu(k,1212) - lu(k,824) * lu(k,1208) + lu(k,1213) = lu(k,1213) - lu(k,825) * lu(k,1208) + lu(k,1214) = lu(k,1214) - lu(k,826) * lu(k,1208) + lu(k,1215) = lu(k,1215) - lu(k,827) * lu(k,1208) + lu(k,1216) = lu(k,1216) - lu(k,828) * lu(k,1208) + lu(k,1217) = lu(k,1217) - lu(k,829) * lu(k,1208) + lu(k,1218) = lu(k,1218) - lu(k,830) * lu(k,1208) + lu(k,1220) = lu(k,1220) - lu(k,831) * lu(k,1208) + lu(k,1234) = lu(k,1234) - lu(k,821) * lu(k,1233) + lu(k,1235) = lu(k,1235) - lu(k,822) * lu(k,1233) + lu(k,1236) = lu(k,1236) - lu(k,823) * lu(k,1233) + lu(k,1237) = lu(k,1237) - lu(k,824) * lu(k,1233) + lu(k,1238) = lu(k,1238) - lu(k,825) * lu(k,1233) + lu(k,1239) = lu(k,1239) - lu(k,826) * lu(k,1233) + lu(k,1240) = lu(k,1240) - lu(k,827) * lu(k,1233) + lu(k,1241) = lu(k,1241) - lu(k,828) * lu(k,1233) + lu(k,1242) = lu(k,1242) - lu(k,829) * lu(k,1233) + lu(k,1243) = lu(k,1243) - lu(k,830) * lu(k,1233) + lu(k,1245) = lu(k,1245) - lu(k,831) * lu(k,1233) + lu(k,1276) = lu(k,1276) - lu(k,821) * lu(k,1275) + lu(k,1277) = lu(k,1277) - lu(k,822) * lu(k,1275) + lu(k,1278) = lu(k,1278) - lu(k,823) * lu(k,1275) + lu(k,1279) = lu(k,1279) - lu(k,824) * lu(k,1275) + lu(k,1280) = lu(k,1280) - lu(k,825) * lu(k,1275) + lu(k,1281) = lu(k,1281) - lu(k,826) * lu(k,1275) + lu(k,1282) = lu(k,1282) - lu(k,827) * lu(k,1275) + lu(k,1283) = lu(k,1283) - lu(k,828) * lu(k,1275) + lu(k,1284) = lu(k,1284) - lu(k,829) * lu(k,1275) + lu(k,1285) = lu(k,1285) - lu(k,830) * lu(k,1275) + lu(k,1287) = lu(k,1287) - lu(k,831) * lu(k,1275) + lu(k,1296) = lu(k,1296) - lu(k,821) * lu(k,1295) + lu(k,1297) = lu(k,1297) - lu(k,822) * lu(k,1295) + lu(k,1298) = lu(k,1298) - lu(k,823) * lu(k,1295) + lu(k,1299) = lu(k,1299) - lu(k,824) * lu(k,1295) + lu(k,1300) = lu(k,1300) - lu(k,825) * lu(k,1295) + lu(k,1301) = lu(k,1301) - lu(k,826) * lu(k,1295) + lu(k,1302) = lu(k,1302) - lu(k,827) * lu(k,1295) + lu(k,1303) = lu(k,1303) - lu(k,828) * lu(k,1295) + lu(k,1304) = lu(k,1304) - lu(k,829) * lu(k,1295) + lu(k,1305) = lu(k,1305) - lu(k,830) * lu(k,1295) + lu(k,1307) = lu(k,1307) - lu(k,831) * lu(k,1295) + lu(k,856) = 1._r8 / lu(k,856) + lu(k,857) = lu(k,857) * lu(k,856) + lu(k,858) = lu(k,858) * lu(k,856) + lu(k,859) = lu(k,859) * lu(k,856) + lu(k,860) = lu(k,860) * lu(k,856) + lu(k,861) = lu(k,861) * lu(k,856) + lu(k,862) = lu(k,862) * lu(k,856) + lu(k,863) = lu(k,863) * lu(k,856) + lu(k,864) = lu(k,864) * lu(k,856) + lu(k,865) = lu(k,865) * lu(k,856) + lu(k,866) = lu(k,866) * lu(k,856) + lu(k,867) = lu(k,867) * lu(k,856) + lu(k,886) = lu(k,886) - lu(k,857) * lu(k,885) + lu(k,887) = lu(k,887) - lu(k,858) * lu(k,885) + lu(k,888) = lu(k,888) - lu(k,859) * lu(k,885) + lu(k,889) = lu(k,889) - lu(k,860) * lu(k,885) + lu(k,890) = lu(k,890) - lu(k,861) * lu(k,885) + lu(k,891) = lu(k,891) - lu(k,862) * lu(k,885) + lu(k,892) = lu(k,892) - lu(k,863) * lu(k,885) + lu(k,893) = lu(k,893) - lu(k,864) * lu(k,885) + lu(k,894) = lu(k,894) - lu(k,865) * lu(k,885) + lu(k,895) = lu(k,895) - lu(k,866) * lu(k,885) + lu(k,896) = lu(k,896) - lu(k,867) * lu(k,885) + lu(k,942) = lu(k,942) - lu(k,857) * lu(k,941) + lu(k,943) = lu(k,943) - lu(k,858) * lu(k,941) + lu(k,944) = lu(k,944) - lu(k,859) * lu(k,941) + lu(k,945) = lu(k,945) - lu(k,860) * lu(k,941) + lu(k,946) = lu(k,946) - lu(k,861) * lu(k,941) + lu(k,947) = lu(k,947) - lu(k,862) * lu(k,941) + lu(k,948) = lu(k,948) - lu(k,863) * lu(k,941) + lu(k,949) = lu(k,949) - lu(k,864) * lu(k,941) + lu(k,950) = lu(k,950) - lu(k,865) * lu(k,941) + lu(k,951) = lu(k,951) - lu(k,866) * lu(k,941) + lu(k,952) = lu(k,952) - lu(k,867) * lu(k,941) + lu(k,964) = lu(k,964) - lu(k,857) * lu(k,963) + lu(k,965) = lu(k,965) - lu(k,858) * lu(k,963) + lu(k,966) = lu(k,966) - lu(k,859) * lu(k,963) + lu(k,967) = lu(k,967) - lu(k,860) * lu(k,963) + lu(k,968) = lu(k,968) - lu(k,861) * lu(k,963) + lu(k,969) = lu(k,969) - lu(k,862) * lu(k,963) + lu(k,970) = lu(k,970) - lu(k,863) * lu(k,963) + lu(k,971) = lu(k,971) - lu(k,864) * lu(k,963) + lu(k,972) = lu(k,972) - lu(k,865) * lu(k,963) + lu(k,973) = lu(k,973) - lu(k,866) * lu(k,963) + lu(k,974) = lu(k,974) - lu(k,867) * lu(k,963) + lu(k,1008) = lu(k,1008) - lu(k,857) * lu(k,1007) + lu(k,1009) = lu(k,1009) - lu(k,858) * lu(k,1007) + lu(k,1010) = lu(k,1010) - lu(k,859) * lu(k,1007) + lu(k,1011) = lu(k,1011) - lu(k,860) * lu(k,1007) + lu(k,1012) = lu(k,1012) - lu(k,861) * lu(k,1007) + lu(k,1013) = lu(k,1013) - lu(k,862) * lu(k,1007) + lu(k,1014) = lu(k,1014) - lu(k,863) * lu(k,1007) + lu(k,1015) = lu(k,1015) - lu(k,864) * lu(k,1007) + lu(k,1016) = lu(k,1016) - lu(k,865) * lu(k,1007) + lu(k,1017) = lu(k,1017) - lu(k,866) * lu(k,1007) + lu(k,1018) = lu(k,1018) - lu(k,867) * lu(k,1007) + lu(k,1044) = lu(k,1044) - lu(k,857) * lu(k,1043) + lu(k,1045) = lu(k,1045) - lu(k,858) * lu(k,1043) + lu(k,1046) = lu(k,1046) - lu(k,859) * lu(k,1043) + lu(k,1047) = lu(k,1047) - lu(k,860) * lu(k,1043) + lu(k,1048) = lu(k,1048) - lu(k,861) * lu(k,1043) + lu(k,1049) = lu(k,1049) - lu(k,862) * lu(k,1043) + lu(k,1050) = lu(k,1050) - lu(k,863) * lu(k,1043) + lu(k,1051) = lu(k,1051) - lu(k,864) * lu(k,1043) + lu(k,1052) = lu(k,1052) - lu(k,865) * lu(k,1043) + lu(k,1053) = lu(k,1053) - lu(k,866) * lu(k,1043) + lu(k,1054) = lu(k,1054) - lu(k,867) * lu(k,1043) + lu(k,1081) = lu(k,1081) - lu(k,857) * lu(k,1080) + lu(k,1082) = lu(k,1082) - lu(k,858) * lu(k,1080) + lu(k,1083) = lu(k,1083) - lu(k,859) * lu(k,1080) + lu(k,1084) = lu(k,1084) - lu(k,860) * lu(k,1080) + lu(k,1085) = lu(k,1085) - lu(k,861) * lu(k,1080) + lu(k,1086) = lu(k,1086) - lu(k,862) * lu(k,1080) + lu(k,1087) = lu(k,1087) - lu(k,863) * lu(k,1080) + lu(k,1088) = lu(k,1088) - lu(k,864) * lu(k,1080) + lu(k,1089) = lu(k,1089) - lu(k,865) * lu(k,1080) + lu(k,1090) = lu(k,1090) - lu(k,866) * lu(k,1080) + lu(k,1091) = lu(k,1091) - lu(k,867) * lu(k,1080) + lu(k,1166) = lu(k,1166) - lu(k,857) * lu(k,1165) + lu(k,1167) = lu(k,1167) - lu(k,858) * lu(k,1165) + lu(k,1168) = lu(k,1168) - lu(k,859) * lu(k,1165) + lu(k,1169) = lu(k,1169) - lu(k,860) * lu(k,1165) + lu(k,1170) = lu(k,1170) - lu(k,861) * lu(k,1165) + lu(k,1171) = lu(k,1171) - lu(k,862) * lu(k,1165) + lu(k,1172) = lu(k,1172) - lu(k,863) * lu(k,1165) + lu(k,1173) = lu(k,1173) - lu(k,864) * lu(k,1165) + lu(k,1174) = lu(k,1174) - lu(k,865) * lu(k,1165) + lu(k,1175) = lu(k,1175) - lu(k,866) * lu(k,1165) + lu(k,1176) = lu(k,1176) - lu(k,867) * lu(k,1165) + lu(k,1210) = lu(k,1210) - lu(k,857) * lu(k,1209) + lu(k,1211) = lu(k,1211) - lu(k,858) * lu(k,1209) + lu(k,1212) = lu(k,1212) - lu(k,859) * lu(k,1209) + lu(k,1213) = lu(k,1213) - lu(k,860) * lu(k,1209) + lu(k,1214) = lu(k,1214) - lu(k,861) * lu(k,1209) + lu(k,1215) = lu(k,1215) - lu(k,862) * lu(k,1209) + lu(k,1216) = lu(k,1216) - lu(k,863) * lu(k,1209) + lu(k,1217) = lu(k,1217) - lu(k,864) * lu(k,1209) + lu(k,1218) = lu(k,1218) - lu(k,865) * lu(k,1209) + lu(k,1219) = lu(k,1219) - lu(k,866) * lu(k,1209) + lu(k,1220) = lu(k,1220) - lu(k,867) * lu(k,1209) + lu(k,1235) = lu(k,1235) - lu(k,857) * lu(k,1234) + lu(k,1236) = lu(k,1236) - lu(k,858) * lu(k,1234) + lu(k,1237) = lu(k,1237) - lu(k,859) * lu(k,1234) + lu(k,1238) = lu(k,1238) - lu(k,860) * lu(k,1234) + lu(k,1239) = lu(k,1239) - lu(k,861) * lu(k,1234) + lu(k,1240) = lu(k,1240) - lu(k,862) * lu(k,1234) + lu(k,1241) = lu(k,1241) - lu(k,863) * lu(k,1234) + lu(k,1242) = lu(k,1242) - lu(k,864) * lu(k,1234) + lu(k,1243) = lu(k,1243) - lu(k,865) * lu(k,1234) + lu(k,1244) = lu(k,1244) - lu(k,866) * lu(k,1234) + lu(k,1245) = lu(k,1245) - lu(k,867) * lu(k,1234) + lu(k,1277) = lu(k,1277) - lu(k,857) * lu(k,1276) + lu(k,1278) = lu(k,1278) - lu(k,858) * lu(k,1276) + lu(k,1279) = lu(k,1279) - lu(k,859) * lu(k,1276) + lu(k,1280) = lu(k,1280) - lu(k,860) * lu(k,1276) + lu(k,1281) = lu(k,1281) - lu(k,861) * lu(k,1276) + lu(k,1282) = lu(k,1282) - lu(k,862) * lu(k,1276) + lu(k,1283) = lu(k,1283) - lu(k,863) * lu(k,1276) + lu(k,1284) = lu(k,1284) - lu(k,864) * lu(k,1276) + lu(k,1285) = lu(k,1285) - lu(k,865) * lu(k,1276) + lu(k,1286) = lu(k,1286) - lu(k,866) * lu(k,1276) + lu(k,1287) = lu(k,1287) - lu(k,867) * lu(k,1276) + lu(k,1297) = lu(k,1297) - lu(k,857) * lu(k,1296) + lu(k,1298) = lu(k,1298) - lu(k,858) * lu(k,1296) + lu(k,1299) = lu(k,1299) - lu(k,859) * lu(k,1296) + lu(k,1300) = lu(k,1300) - lu(k,860) * lu(k,1296) + lu(k,1301) = lu(k,1301) - lu(k,861) * lu(k,1296) + lu(k,1302) = lu(k,1302) - lu(k,862) * lu(k,1296) + lu(k,1303) = lu(k,1303) - lu(k,863) * lu(k,1296) + lu(k,1304) = lu(k,1304) - lu(k,864) * lu(k,1296) + lu(k,1305) = lu(k,1305) - lu(k,865) * lu(k,1296) + lu(k,1306) = lu(k,1306) - lu(k,866) * lu(k,1296) + lu(k,1307) = lu(k,1307) - lu(k,867) * lu(k,1296) + end do + end subroutine lu_fac16 + subroutine lu_fac17( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,886) = 1._r8 / lu(k,886) + lu(k,887) = lu(k,887) * lu(k,886) + lu(k,888) = lu(k,888) * lu(k,886) + lu(k,889) = lu(k,889) * lu(k,886) + lu(k,890) = lu(k,890) * lu(k,886) + lu(k,891) = lu(k,891) * lu(k,886) + lu(k,892) = lu(k,892) * lu(k,886) + lu(k,893) = lu(k,893) * lu(k,886) + lu(k,894) = lu(k,894) * lu(k,886) + lu(k,895) = lu(k,895) * lu(k,886) + lu(k,896) = lu(k,896) * lu(k,886) + lu(k,943) = lu(k,943) - lu(k,887) * lu(k,942) + lu(k,944) = lu(k,944) - lu(k,888) * lu(k,942) + lu(k,945) = lu(k,945) - lu(k,889) * lu(k,942) + lu(k,946) = lu(k,946) - lu(k,890) * lu(k,942) + lu(k,947) = lu(k,947) - lu(k,891) * lu(k,942) + lu(k,948) = lu(k,948) - lu(k,892) * lu(k,942) + lu(k,949) = lu(k,949) - lu(k,893) * lu(k,942) + lu(k,950) = lu(k,950) - lu(k,894) * lu(k,942) + lu(k,951) = lu(k,951) - lu(k,895) * lu(k,942) + lu(k,952) = lu(k,952) - lu(k,896) * lu(k,942) + lu(k,965) = lu(k,965) - lu(k,887) * lu(k,964) + lu(k,966) = lu(k,966) - lu(k,888) * lu(k,964) + lu(k,967) = lu(k,967) - lu(k,889) * lu(k,964) + lu(k,968) = lu(k,968) - lu(k,890) * lu(k,964) + lu(k,969) = lu(k,969) - lu(k,891) * lu(k,964) + lu(k,970) = lu(k,970) - lu(k,892) * lu(k,964) + lu(k,971) = lu(k,971) - lu(k,893) * lu(k,964) + lu(k,972) = lu(k,972) - lu(k,894) * lu(k,964) + lu(k,973) = lu(k,973) - lu(k,895) * lu(k,964) + lu(k,974) = lu(k,974) - lu(k,896) * lu(k,964) + lu(k,1009) = lu(k,1009) - lu(k,887) * lu(k,1008) + lu(k,1010) = lu(k,1010) - lu(k,888) * lu(k,1008) + lu(k,1011) = lu(k,1011) - lu(k,889) * lu(k,1008) + lu(k,1012) = lu(k,1012) - lu(k,890) * lu(k,1008) + lu(k,1013) = lu(k,1013) - lu(k,891) * lu(k,1008) + lu(k,1014) = lu(k,1014) - lu(k,892) * lu(k,1008) + lu(k,1015) = lu(k,1015) - lu(k,893) * lu(k,1008) + lu(k,1016) = lu(k,1016) - lu(k,894) * lu(k,1008) + lu(k,1017) = lu(k,1017) - lu(k,895) * lu(k,1008) + lu(k,1018) = lu(k,1018) - lu(k,896) * lu(k,1008) + lu(k,1045) = lu(k,1045) - lu(k,887) * lu(k,1044) + lu(k,1046) = lu(k,1046) - lu(k,888) * lu(k,1044) + lu(k,1047) = lu(k,1047) - lu(k,889) * lu(k,1044) + lu(k,1048) = lu(k,1048) - lu(k,890) * lu(k,1044) + lu(k,1049) = lu(k,1049) - lu(k,891) * lu(k,1044) + lu(k,1050) = lu(k,1050) - lu(k,892) * lu(k,1044) + lu(k,1051) = lu(k,1051) - lu(k,893) * lu(k,1044) + lu(k,1052) = lu(k,1052) - lu(k,894) * lu(k,1044) + lu(k,1053) = lu(k,1053) - lu(k,895) * lu(k,1044) + lu(k,1054) = lu(k,1054) - lu(k,896) * lu(k,1044) + lu(k,1082) = lu(k,1082) - lu(k,887) * lu(k,1081) + lu(k,1083) = lu(k,1083) - lu(k,888) * lu(k,1081) + lu(k,1084) = lu(k,1084) - lu(k,889) * lu(k,1081) + lu(k,1085) = lu(k,1085) - lu(k,890) * lu(k,1081) + lu(k,1086) = lu(k,1086) - lu(k,891) * lu(k,1081) + lu(k,1087) = lu(k,1087) - lu(k,892) * lu(k,1081) + lu(k,1088) = lu(k,1088) - lu(k,893) * lu(k,1081) + lu(k,1089) = lu(k,1089) - lu(k,894) * lu(k,1081) + lu(k,1090) = lu(k,1090) - lu(k,895) * lu(k,1081) + lu(k,1091) = lu(k,1091) - lu(k,896) * lu(k,1081) + lu(k,1167) = lu(k,1167) - lu(k,887) * lu(k,1166) + lu(k,1168) = lu(k,1168) - lu(k,888) * lu(k,1166) + lu(k,1169) = lu(k,1169) - lu(k,889) * lu(k,1166) + lu(k,1170) = lu(k,1170) - lu(k,890) * lu(k,1166) + lu(k,1171) = lu(k,1171) - lu(k,891) * lu(k,1166) + lu(k,1172) = lu(k,1172) - lu(k,892) * lu(k,1166) + lu(k,1173) = lu(k,1173) - lu(k,893) * lu(k,1166) + lu(k,1174) = lu(k,1174) - lu(k,894) * lu(k,1166) + lu(k,1175) = lu(k,1175) - lu(k,895) * lu(k,1166) + lu(k,1176) = lu(k,1176) - lu(k,896) * lu(k,1166) + lu(k,1211) = lu(k,1211) - lu(k,887) * lu(k,1210) + lu(k,1212) = lu(k,1212) - lu(k,888) * lu(k,1210) + lu(k,1213) = lu(k,1213) - lu(k,889) * lu(k,1210) + lu(k,1214) = lu(k,1214) - lu(k,890) * lu(k,1210) + lu(k,1215) = lu(k,1215) - lu(k,891) * lu(k,1210) + lu(k,1216) = lu(k,1216) - lu(k,892) * lu(k,1210) + lu(k,1217) = lu(k,1217) - lu(k,893) * lu(k,1210) + lu(k,1218) = lu(k,1218) - lu(k,894) * lu(k,1210) + lu(k,1219) = lu(k,1219) - lu(k,895) * lu(k,1210) + lu(k,1220) = lu(k,1220) - lu(k,896) * lu(k,1210) + lu(k,1236) = lu(k,1236) - lu(k,887) * lu(k,1235) + lu(k,1237) = lu(k,1237) - lu(k,888) * lu(k,1235) + lu(k,1238) = lu(k,1238) - lu(k,889) * lu(k,1235) + lu(k,1239) = lu(k,1239) - lu(k,890) * lu(k,1235) + lu(k,1240) = lu(k,1240) - lu(k,891) * lu(k,1235) + lu(k,1241) = lu(k,1241) - lu(k,892) * lu(k,1235) + lu(k,1242) = lu(k,1242) - lu(k,893) * lu(k,1235) + lu(k,1243) = lu(k,1243) - lu(k,894) * lu(k,1235) + lu(k,1244) = lu(k,1244) - lu(k,895) * lu(k,1235) + lu(k,1245) = lu(k,1245) - lu(k,896) * lu(k,1235) + lu(k,1278) = lu(k,1278) - lu(k,887) * lu(k,1277) + lu(k,1279) = lu(k,1279) - lu(k,888) * lu(k,1277) + lu(k,1280) = lu(k,1280) - lu(k,889) * lu(k,1277) + lu(k,1281) = lu(k,1281) - lu(k,890) * lu(k,1277) + lu(k,1282) = lu(k,1282) - lu(k,891) * lu(k,1277) + lu(k,1283) = lu(k,1283) - lu(k,892) * lu(k,1277) + lu(k,1284) = lu(k,1284) - lu(k,893) * lu(k,1277) + lu(k,1285) = lu(k,1285) - lu(k,894) * lu(k,1277) + lu(k,1286) = lu(k,1286) - lu(k,895) * lu(k,1277) + lu(k,1287) = lu(k,1287) - lu(k,896) * lu(k,1277) + lu(k,1298) = lu(k,1298) - lu(k,887) * lu(k,1297) + lu(k,1299) = lu(k,1299) - lu(k,888) * lu(k,1297) + lu(k,1300) = lu(k,1300) - lu(k,889) * lu(k,1297) + lu(k,1301) = lu(k,1301) - lu(k,890) * lu(k,1297) + lu(k,1302) = lu(k,1302) - lu(k,891) * lu(k,1297) + lu(k,1303) = lu(k,1303) - lu(k,892) * lu(k,1297) + lu(k,1304) = lu(k,1304) - lu(k,893) * lu(k,1297) + lu(k,1305) = lu(k,1305) - lu(k,894) * lu(k,1297) + lu(k,1306) = lu(k,1306) - lu(k,895) * lu(k,1297) + lu(k,1307) = lu(k,1307) - lu(k,896) * lu(k,1297) + lu(k,943) = 1._r8 / lu(k,943) + lu(k,944) = lu(k,944) * lu(k,943) + lu(k,945) = lu(k,945) * lu(k,943) + lu(k,946) = lu(k,946) * lu(k,943) + lu(k,947) = lu(k,947) * lu(k,943) + lu(k,948) = lu(k,948) * lu(k,943) + lu(k,949) = lu(k,949) * lu(k,943) + lu(k,950) = lu(k,950) * lu(k,943) + lu(k,951) = lu(k,951) * lu(k,943) + lu(k,952) = lu(k,952) * lu(k,943) + lu(k,966) = lu(k,966) - lu(k,944) * lu(k,965) + lu(k,967) = lu(k,967) - lu(k,945) * lu(k,965) + lu(k,968) = lu(k,968) - lu(k,946) * lu(k,965) + lu(k,969) = lu(k,969) - lu(k,947) * lu(k,965) + lu(k,970) = lu(k,970) - lu(k,948) * lu(k,965) + lu(k,971) = lu(k,971) - lu(k,949) * lu(k,965) + lu(k,972) = lu(k,972) - lu(k,950) * lu(k,965) + lu(k,973) = lu(k,973) - lu(k,951) * lu(k,965) + lu(k,974) = lu(k,974) - lu(k,952) * lu(k,965) + lu(k,1010) = lu(k,1010) - lu(k,944) * lu(k,1009) + lu(k,1011) = lu(k,1011) - lu(k,945) * lu(k,1009) + lu(k,1012) = lu(k,1012) - lu(k,946) * lu(k,1009) + lu(k,1013) = lu(k,1013) - lu(k,947) * lu(k,1009) + lu(k,1014) = lu(k,1014) - lu(k,948) * lu(k,1009) + lu(k,1015) = lu(k,1015) - lu(k,949) * lu(k,1009) + lu(k,1016) = lu(k,1016) - lu(k,950) * lu(k,1009) + lu(k,1017) = lu(k,1017) - lu(k,951) * lu(k,1009) + lu(k,1018) = lu(k,1018) - lu(k,952) * lu(k,1009) + lu(k,1046) = lu(k,1046) - lu(k,944) * lu(k,1045) + lu(k,1047) = lu(k,1047) - lu(k,945) * lu(k,1045) + lu(k,1048) = lu(k,1048) - lu(k,946) * lu(k,1045) + lu(k,1049) = lu(k,1049) - lu(k,947) * lu(k,1045) + lu(k,1050) = lu(k,1050) - lu(k,948) * lu(k,1045) + lu(k,1051) = lu(k,1051) - lu(k,949) * lu(k,1045) + lu(k,1052) = lu(k,1052) - lu(k,950) * lu(k,1045) + lu(k,1053) = lu(k,1053) - lu(k,951) * lu(k,1045) + lu(k,1054) = lu(k,1054) - lu(k,952) * lu(k,1045) + lu(k,1083) = lu(k,1083) - lu(k,944) * lu(k,1082) + lu(k,1084) = lu(k,1084) - lu(k,945) * lu(k,1082) + lu(k,1085) = lu(k,1085) - lu(k,946) * lu(k,1082) + lu(k,1086) = lu(k,1086) - lu(k,947) * lu(k,1082) + lu(k,1087) = lu(k,1087) - lu(k,948) * lu(k,1082) + lu(k,1088) = lu(k,1088) - lu(k,949) * lu(k,1082) + lu(k,1089) = lu(k,1089) - lu(k,950) * lu(k,1082) + lu(k,1090) = lu(k,1090) - lu(k,951) * lu(k,1082) + lu(k,1091) = lu(k,1091) - lu(k,952) * lu(k,1082) + lu(k,1168) = lu(k,1168) - lu(k,944) * lu(k,1167) + lu(k,1169) = lu(k,1169) - lu(k,945) * lu(k,1167) + lu(k,1170) = lu(k,1170) - lu(k,946) * lu(k,1167) + lu(k,1171) = lu(k,1171) - lu(k,947) * lu(k,1167) + lu(k,1172) = lu(k,1172) - lu(k,948) * lu(k,1167) + lu(k,1173) = lu(k,1173) - lu(k,949) * lu(k,1167) + lu(k,1174) = lu(k,1174) - lu(k,950) * lu(k,1167) + lu(k,1175) = lu(k,1175) - lu(k,951) * lu(k,1167) + lu(k,1176) = lu(k,1176) - lu(k,952) * lu(k,1167) + lu(k,1212) = lu(k,1212) - lu(k,944) * lu(k,1211) + lu(k,1213) = lu(k,1213) - lu(k,945) * lu(k,1211) + lu(k,1214) = lu(k,1214) - lu(k,946) * lu(k,1211) + lu(k,1215) = lu(k,1215) - lu(k,947) * lu(k,1211) + lu(k,1216) = lu(k,1216) - lu(k,948) * lu(k,1211) + lu(k,1217) = lu(k,1217) - lu(k,949) * lu(k,1211) + lu(k,1218) = lu(k,1218) - lu(k,950) * lu(k,1211) + lu(k,1219) = lu(k,1219) - lu(k,951) * lu(k,1211) + lu(k,1220) = lu(k,1220) - lu(k,952) * lu(k,1211) + lu(k,1237) = lu(k,1237) - lu(k,944) * lu(k,1236) + lu(k,1238) = lu(k,1238) - lu(k,945) * lu(k,1236) + lu(k,1239) = lu(k,1239) - lu(k,946) * lu(k,1236) + lu(k,1240) = lu(k,1240) - lu(k,947) * lu(k,1236) + lu(k,1241) = lu(k,1241) - lu(k,948) * lu(k,1236) + lu(k,1242) = lu(k,1242) - lu(k,949) * lu(k,1236) + lu(k,1243) = lu(k,1243) - lu(k,950) * lu(k,1236) + lu(k,1244) = lu(k,1244) - lu(k,951) * lu(k,1236) + lu(k,1245) = lu(k,1245) - lu(k,952) * lu(k,1236) + lu(k,1279) = lu(k,1279) - lu(k,944) * lu(k,1278) + lu(k,1280) = lu(k,1280) - lu(k,945) * lu(k,1278) + lu(k,1281) = lu(k,1281) - lu(k,946) * lu(k,1278) + lu(k,1282) = lu(k,1282) - lu(k,947) * lu(k,1278) + lu(k,1283) = lu(k,1283) - lu(k,948) * lu(k,1278) + lu(k,1284) = lu(k,1284) - lu(k,949) * lu(k,1278) + lu(k,1285) = lu(k,1285) - lu(k,950) * lu(k,1278) + lu(k,1286) = lu(k,1286) - lu(k,951) * lu(k,1278) + lu(k,1287) = lu(k,1287) - lu(k,952) * lu(k,1278) + lu(k,1299) = lu(k,1299) - lu(k,944) * lu(k,1298) + lu(k,1300) = lu(k,1300) - lu(k,945) * lu(k,1298) + lu(k,1301) = lu(k,1301) - lu(k,946) * lu(k,1298) + lu(k,1302) = lu(k,1302) - lu(k,947) * lu(k,1298) + lu(k,1303) = lu(k,1303) - lu(k,948) * lu(k,1298) + lu(k,1304) = lu(k,1304) - lu(k,949) * lu(k,1298) + lu(k,1305) = lu(k,1305) - lu(k,950) * lu(k,1298) + lu(k,1306) = lu(k,1306) - lu(k,951) * lu(k,1298) + lu(k,1307) = lu(k,1307) - lu(k,952) * lu(k,1298) + lu(k,966) = 1._r8 / lu(k,966) + lu(k,967) = lu(k,967) * lu(k,966) + lu(k,968) = lu(k,968) * lu(k,966) + lu(k,969) = lu(k,969) * lu(k,966) + lu(k,970) = lu(k,970) * lu(k,966) + lu(k,971) = lu(k,971) * lu(k,966) + lu(k,972) = lu(k,972) * lu(k,966) + lu(k,973) = lu(k,973) * lu(k,966) + lu(k,974) = lu(k,974) * lu(k,966) + lu(k,1011) = lu(k,1011) - lu(k,967) * lu(k,1010) + lu(k,1012) = lu(k,1012) - lu(k,968) * lu(k,1010) + lu(k,1013) = lu(k,1013) - lu(k,969) * lu(k,1010) + lu(k,1014) = lu(k,1014) - lu(k,970) * lu(k,1010) + lu(k,1015) = lu(k,1015) - lu(k,971) * lu(k,1010) + lu(k,1016) = lu(k,1016) - lu(k,972) * lu(k,1010) + lu(k,1017) = lu(k,1017) - lu(k,973) * lu(k,1010) + lu(k,1018) = lu(k,1018) - lu(k,974) * lu(k,1010) + lu(k,1047) = lu(k,1047) - lu(k,967) * lu(k,1046) + lu(k,1048) = lu(k,1048) - lu(k,968) * lu(k,1046) + lu(k,1049) = lu(k,1049) - lu(k,969) * lu(k,1046) + lu(k,1050) = lu(k,1050) - lu(k,970) * lu(k,1046) + lu(k,1051) = lu(k,1051) - lu(k,971) * lu(k,1046) + lu(k,1052) = lu(k,1052) - lu(k,972) * lu(k,1046) + lu(k,1053) = lu(k,1053) - lu(k,973) * lu(k,1046) + lu(k,1054) = lu(k,1054) - lu(k,974) * lu(k,1046) + lu(k,1084) = lu(k,1084) - lu(k,967) * lu(k,1083) + lu(k,1085) = lu(k,1085) - lu(k,968) * lu(k,1083) + lu(k,1086) = lu(k,1086) - lu(k,969) * lu(k,1083) + lu(k,1087) = lu(k,1087) - lu(k,970) * lu(k,1083) + lu(k,1088) = lu(k,1088) - lu(k,971) * lu(k,1083) + lu(k,1089) = lu(k,1089) - lu(k,972) * lu(k,1083) + lu(k,1090) = lu(k,1090) - lu(k,973) * lu(k,1083) + lu(k,1091) = lu(k,1091) - lu(k,974) * lu(k,1083) + lu(k,1169) = lu(k,1169) - lu(k,967) * lu(k,1168) + lu(k,1170) = lu(k,1170) - lu(k,968) * lu(k,1168) + lu(k,1171) = lu(k,1171) - lu(k,969) * lu(k,1168) + lu(k,1172) = lu(k,1172) - lu(k,970) * lu(k,1168) + lu(k,1173) = lu(k,1173) - lu(k,971) * lu(k,1168) + lu(k,1174) = lu(k,1174) - lu(k,972) * lu(k,1168) + lu(k,1175) = lu(k,1175) - lu(k,973) * lu(k,1168) + lu(k,1176) = lu(k,1176) - lu(k,974) * lu(k,1168) + lu(k,1213) = lu(k,1213) - lu(k,967) * lu(k,1212) + lu(k,1214) = lu(k,1214) - lu(k,968) * lu(k,1212) + lu(k,1215) = lu(k,1215) - lu(k,969) * lu(k,1212) + lu(k,1216) = lu(k,1216) - lu(k,970) * lu(k,1212) + lu(k,1217) = lu(k,1217) - lu(k,971) * lu(k,1212) + lu(k,1218) = lu(k,1218) - lu(k,972) * lu(k,1212) + lu(k,1219) = lu(k,1219) - lu(k,973) * lu(k,1212) + lu(k,1220) = lu(k,1220) - lu(k,974) * lu(k,1212) + lu(k,1238) = lu(k,1238) - lu(k,967) * lu(k,1237) + lu(k,1239) = lu(k,1239) - lu(k,968) * lu(k,1237) + lu(k,1240) = lu(k,1240) - lu(k,969) * lu(k,1237) + lu(k,1241) = lu(k,1241) - lu(k,970) * lu(k,1237) + lu(k,1242) = lu(k,1242) - lu(k,971) * lu(k,1237) + lu(k,1243) = lu(k,1243) - lu(k,972) * lu(k,1237) + lu(k,1244) = lu(k,1244) - lu(k,973) * lu(k,1237) + lu(k,1245) = lu(k,1245) - lu(k,974) * lu(k,1237) + lu(k,1280) = lu(k,1280) - lu(k,967) * lu(k,1279) + lu(k,1281) = lu(k,1281) - lu(k,968) * lu(k,1279) + lu(k,1282) = lu(k,1282) - lu(k,969) * lu(k,1279) + lu(k,1283) = lu(k,1283) - lu(k,970) * lu(k,1279) + lu(k,1284) = lu(k,1284) - lu(k,971) * lu(k,1279) + lu(k,1285) = lu(k,1285) - lu(k,972) * lu(k,1279) + lu(k,1286) = lu(k,1286) - lu(k,973) * lu(k,1279) + lu(k,1287) = lu(k,1287) - lu(k,974) * lu(k,1279) + lu(k,1300) = lu(k,1300) - lu(k,967) * lu(k,1299) + lu(k,1301) = lu(k,1301) - lu(k,968) * lu(k,1299) + lu(k,1302) = lu(k,1302) - lu(k,969) * lu(k,1299) + lu(k,1303) = lu(k,1303) - lu(k,970) * lu(k,1299) + lu(k,1304) = lu(k,1304) - lu(k,971) * lu(k,1299) + lu(k,1305) = lu(k,1305) - lu(k,972) * lu(k,1299) + lu(k,1306) = lu(k,1306) - lu(k,973) * lu(k,1299) + lu(k,1307) = lu(k,1307) - lu(k,974) * lu(k,1299) + lu(k,1011) = 1._r8 / lu(k,1011) + lu(k,1012) = lu(k,1012) * lu(k,1011) + lu(k,1013) = lu(k,1013) * lu(k,1011) + lu(k,1014) = lu(k,1014) * lu(k,1011) + lu(k,1015) = lu(k,1015) * lu(k,1011) + lu(k,1016) = lu(k,1016) * lu(k,1011) + lu(k,1017) = lu(k,1017) * lu(k,1011) + lu(k,1018) = lu(k,1018) * lu(k,1011) + lu(k,1048) = lu(k,1048) - lu(k,1012) * lu(k,1047) + lu(k,1049) = lu(k,1049) - lu(k,1013) * lu(k,1047) + lu(k,1050) = lu(k,1050) - lu(k,1014) * lu(k,1047) + lu(k,1051) = lu(k,1051) - lu(k,1015) * lu(k,1047) + lu(k,1052) = lu(k,1052) - lu(k,1016) * lu(k,1047) + lu(k,1053) = lu(k,1053) - lu(k,1017) * lu(k,1047) + lu(k,1054) = lu(k,1054) - lu(k,1018) * lu(k,1047) + lu(k,1085) = lu(k,1085) - lu(k,1012) * lu(k,1084) + lu(k,1086) = lu(k,1086) - lu(k,1013) * lu(k,1084) + lu(k,1087) = lu(k,1087) - lu(k,1014) * lu(k,1084) + lu(k,1088) = lu(k,1088) - lu(k,1015) * lu(k,1084) + lu(k,1089) = lu(k,1089) - lu(k,1016) * lu(k,1084) + lu(k,1090) = lu(k,1090) - lu(k,1017) * lu(k,1084) + lu(k,1091) = lu(k,1091) - lu(k,1018) * lu(k,1084) + lu(k,1170) = lu(k,1170) - lu(k,1012) * lu(k,1169) + lu(k,1171) = lu(k,1171) - lu(k,1013) * lu(k,1169) + lu(k,1172) = lu(k,1172) - lu(k,1014) * lu(k,1169) + lu(k,1173) = lu(k,1173) - lu(k,1015) * lu(k,1169) + lu(k,1174) = lu(k,1174) - lu(k,1016) * lu(k,1169) + lu(k,1175) = lu(k,1175) - lu(k,1017) * lu(k,1169) + lu(k,1176) = lu(k,1176) - lu(k,1018) * lu(k,1169) + lu(k,1214) = lu(k,1214) - lu(k,1012) * lu(k,1213) + lu(k,1215) = lu(k,1215) - lu(k,1013) * lu(k,1213) + lu(k,1216) = lu(k,1216) - lu(k,1014) * lu(k,1213) + lu(k,1217) = lu(k,1217) - lu(k,1015) * lu(k,1213) + lu(k,1218) = lu(k,1218) - lu(k,1016) * lu(k,1213) + lu(k,1219) = lu(k,1219) - lu(k,1017) * lu(k,1213) + lu(k,1220) = lu(k,1220) - lu(k,1018) * lu(k,1213) + lu(k,1239) = lu(k,1239) - lu(k,1012) * lu(k,1238) + lu(k,1240) = lu(k,1240) - lu(k,1013) * lu(k,1238) + lu(k,1241) = lu(k,1241) - lu(k,1014) * lu(k,1238) + lu(k,1242) = lu(k,1242) - lu(k,1015) * lu(k,1238) + lu(k,1243) = lu(k,1243) - lu(k,1016) * lu(k,1238) + lu(k,1244) = lu(k,1244) - lu(k,1017) * lu(k,1238) + lu(k,1245) = lu(k,1245) - lu(k,1018) * lu(k,1238) + lu(k,1281) = lu(k,1281) - lu(k,1012) * lu(k,1280) + lu(k,1282) = lu(k,1282) - lu(k,1013) * lu(k,1280) + lu(k,1283) = lu(k,1283) - lu(k,1014) * lu(k,1280) + lu(k,1284) = lu(k,1284) - lu(k,1015) * lu(k,1280) + lu(k,1285) = lu(k,1285) - lu(k,1016) * lu(k,1280) + lu(k,1286) = lu(k,1286) - lu(k,1017) * lu(k,1280) + lu(k,1287) = lu(k,1287) - lu(k,1018) * lu(k,1280) + lu(k,1301) = lu(k,1301) - lu(k,1012) * lu(k,1300) + lu(k,1302) = lu(k,1302) - lu(k,1013) * lu(k,1300) + lu(k,1303) = lu(k,1303) - lu(k,1014) * lu(k,1300) + lu(k,1304) = lu(k,1304) - lu(k,1015) * lu(k,1300) + lu(k,1305) = lu(k,1305) - lu(k,1016) * lu(k,1300) + lu(k,1306) = lu(k,1306) - lu(k,1017) * lu(k,1300) + lu(k,1307) = lu(k,1307) - lu(k,1018) * lu(k,1300) + lu(k,1048) = 1._r8 / lu(k,1048) + lu(k,1049) = lu(k,1049) * lu(k,1048) + lu(k,1050) = lu(k,1050) * lu(k,1048) + lu(k,1051) = lu(k,1051) * lu(k,1048) + lu(k,1052) = lu(k,1052) * lu(k,1048) + lu(k,1053) = lu(k,1053) * lu(k,1048) + lu(k,1054) = lu(k,1054) * lu(k,1048) + lu(k,1086) = lu(k,1086) - lu(k,1049) * lu(k,1085) + lu(k,1087) = lu(k,1087) - lu(k,1050) * lu(k,1085) + lu(k,1088) = lu(k,1088) - lu(k,1051) * lu(k,1085) + lu(k,1089) = lu(k,1089) - lu(k,1052) * lu(k,1085) + lu(k,1090) = lu(k,1090) - lu(k,1053) * lu(k,1085) + lu(k,1091) = lu(k,1091) - lu(k,1054) * lu(k,1085) + lu(k,1171) = lu(k,1171) - lu(k,1049) * lu(k,1170) + lu(k,1172) = lu(k,1172) - lu(k,1050) * lu(k,1170) + lu(k,1173) = lu(k,1173) - lu(k,1051) * lu(k,1170) + lu(k,1174) = lu(k,1174) - lu(k,1052) * lu(k,1170) + lu(k,1175) = lu(k,1175) - lu(k,1053) * lu(k,1170) + lu(k,1176) = lu(k,1176) - lu(k,1054) * lu(k,1170) + lu(k,1215) = lu(k,1215) - lu(k,1049) * lu(k,1214) + lu(k,1216) = lu(k,1216) - lu(k,1050) * lu(k,1214) + lu(k,1217) = lu(k,1217) - lu(k,1051) * lu(k,1214) + lu(k,1218) = lu(k,1218) - lu(k,1052) * lu(k,1214) + lu(k,1219) = lu(k,1219) - lu(k,1053) * lu(k,1214) + lu(k,1220) = lu(k,1220) - lu(k,1054) * lu(k,1214) + lu(k,1240) = lu(k,1240) - lu(k,1049) * lu(k,1239) + lu(k,1241) = lu(k,1241) - lu(k,1050) * lu(k,1239) + lu(k,1242) = lu(k,1242) - lu(k,1051) * lu(k,1239) + lu(k,1243) = lu(k,1243) - lu(k,1052) * lu(k,1239) + lu(k,1244) = lu(k,1244) - lu(k,1053) * lu(k,1239) + lu(k,1245) = lu(k,1245) - lu(k,1054) * lu(k,1239) + lu(k,1282) = lu(k,1282) - lu(k,1049) * lu(k,1281) + lu(k,1283) = lu(k,1283) - lu(k,1050) * lu(k,1281) + lu(k,1284) = lu(k,1284) - lu(k,1051) * lu(k,1281) + lu(k,1285) = lu(k,1285) - lu(k,1052) * lu(k,1281) + lu(k,1286) = lu(k,1286) - lu(k,1053) * lu(k,1281) + lu(k,1287) = lu(k,1287) - lu(k,1054) * lu(k,1281) + lu(k,1302) = lu(k,1302) - lu(k,1049) * lu(k,1301) + lu(k,1303) = lu(k,1303) - lu(k,1050) * lu(k,1301) + lu(k,1304) = lu(k,1304) - lu(k,1051) * lu(k,1301) + lu(k,1305) = lu(k,1305) - lu(k,1052) * lu(k,1301) + lu(k,1306) = lu(k,1306) - lu(k,1053) * lu(k,1301) + lu(k,1307) = lu(k,1307) - lu(k,1054) * lu(k,1301) + lu(k,1086) = 1._r8 / lu(k,1086) + lu(k,1087) = lu(k,1087) * lu(k,1086) + lu(k,1088) = lu(k,1088) * lu(k,1086) + lu(k,1089) = lu(k,1089) * lu(k,1086) + lu(k,1090) = lu(k,1090) * lu(k,1086) + lu(k,1091) = lu(k,1091) * lu(k,1086) + lu(k,1172) = lu(k,1172) - lu(k,1087) * lu(k,1171) + lu(k,1173) = lu(k,1173) - lu(k,1088) * lu(k,1171) + lu(k,1174) = lu(k,1174) - lu(k,1089) * lu(k,1171) + lu(k,1175) = lu(k,1175) - lu(k,1090) * lu(k,1171) + lu(k,1176) = lu(k,1176) - lu(k,1091) * lu(k,1171) + lu(k,1216) = lu(k,1216) - lu(k,1087) * lu(k,1215) + lu(k,1217) = lu(k,1217) - lu(k,1088) * lu(k,1215) + lu(k,1218) = lu(k,1218) - lu(k,1089) * lu(k,1215) + lu(k,1219) = lu(k,1219) - lu(k,1090) * lu(k,1215) + lu(k,1220) = lu(k,1220) - lu(k,1091) * lu(k,1215) + lu(k,1241) = lu(k,1241) - lu(k,1087) * lu(k,1240) + lu(k,1242) = lu(k,1242) - lu(k,1088) * lu(k,1240) + lu(k,1243) = lu(k,1243) - lu(k,1089) * lu(k,1240) + lu(k,1244) = lu(k,1244) - lu(k,1090) * lu(k,1240) + lu(k,1245) = lu(k,1245) - lu(k,1091) * lu(k,1240) + lu(k,1283) = lu(k,1283) - lu(k,1087) * lu(k,1282) + lu(k,1284) = lu(k,1284) - lu(k,1088) * lu(k,1282) + lu(k,1285) = lu(k,1285) - lu(k,1089) * lu(k,1282) + lu(k,1286) = lu(k,1286) - lu(k,1090) * lu(k,1282) + lu(k,1287) = lu(k,1287) - lu(k,1091) * lu(k,1282) + lu(k,1303) = lu(k,1303) - lu(k,1087) * lu(k,1302) + lu(k,1304) = lu(k,1304) - lu(k,1088) * lu(k,1302) + lu(k,1305) = lu(k,1305) - lu(k,1089) * lu(k,1302) + lu(k,1306) = lu(k,1306) - lu(k,1090) * lu(k,1302) + lu(k,1307) = lu(k,1307) - lu(k,1091) * lu(k,1302) + end do + end subroutine lu_fac17 + subroutine lu_fac18( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1172) = 1._r8 / lu(k,1172) + lu(k,1173) = lu(k,1173) * lu(k,1172) + lu(k,1174) = lu(k,1174) * lu(k,1172) + lu(k,1175) = lu(k,1175) * lu(k,1172) + lu(k,1176) = lu(k,1176) * lu(k,1172) + lu(k,1217) = lu(k,1217) - lu(k,1173) * lu(k,1216) + lu(k,1218) = lu(k,1218) - lu(k,1174) * lu(k,1216) + lu(k,1219) = lu(k,1219) - lu(k,1175) * lu(k,1216) + lu(k,1220) = lu(k,1220) - lu(k,1176) * lu(k,1216) + lu(k,1242) = lu(k,1242) - lu(k,1173) * lu(k,1241) + lu(k,1243) = lu(k,1243) - lu(k,1174) * lu(k,1241) + lu(k,1244) = lu(k,1244) - lu(k,1175) * lu(k,1241) + lu(k,1245) = lu(k,1245) - lu(k,1176) * lu(k,1241) + lu(k,1284) = lu(k,1284) - lu(k,1173) * lu(k,1283) + lu(k,1285) = lu(k,1285) - lu(k,1174) * lu(k,1283) + lu(k,1286) = lu(k,1286) - lu(k,1175) * lu(k,1283) + lu(k,1287) = lu(k,1287) - lu(k,1176) * lu(k,1283) + lu(k,1304) = lu(k,1304) - lu(k,1173) * lu(k,1303) + lu(k,1305) = lu(k,1305) - lu(k,1174) * lu(k,1303) + lu(k,1306) = lu(k,1306) - lu(k,1175) * lu(k,1303) + lu(k,1307) = lu(k,1307) - lu(k,1176) * lu(k,1303) + lu(k,1217) = 1._r8 / lu(k,1217) + lu(k,1218) = lu(k,1218) * lu(k,1217) + lu(k,1219) = lu(k,1219) * lu(k,1217) + lu(k,1220) = lu(k,1220) * lu(k,1217) + lu(k,1243) = lu(k,1243) - lu(k,1218) * lu(k,1242) + lu(k,1244) = lu(k,1244) - lu(k,1219) * lu(k,1242) + lu(k,1245) = lu(k,1245) - lu(k,1220) * lu(k,1242) + lu(k,1285) = lu(k,1285) - lu(k,1218) * lu(k,1284) + lu(k,1286) = lu(k,1286) - lu(k,1219) * lu(k,1284) + lu(k,1287) = lu(k,1287) - lu(k,1220) * lu(k,1284) + lu(k,1305) = lu(k,1305) - lu(k,1218) * lu(k,1304) + lu(k,1306) = lu(k,1306) - lu(k,1219) * lu(k,1304) + lu(k,1307) = lu(k,1307) - lu(k,1220) * lu(k,1304) + lu(k,1243) = 1._r8 / lu(k,1243) + lu(k,1244) = lu(k,1244) * lu(k,1243) + lu(k,1245) = lu(k,1245) * lu(k,1243) + lu(k,1286) = lu(k,1286) - lu(k,1244) * lu(k,1285) + lu(k,1287) = lu(k,1287) - lu(k,1245) * lu(k,1285) + lu(k,1306) = lu(k,1306) - lu(k,1244) * lu(k,1305) + lu(k,1307) = lu(k,1307) - lu(k,1245) * lu(k,1305) + lu(k,1286) = 1._r8 / lu(k,1286) + lu(k,1287) = lu(k,1287) * lu(k,1286) + lu(k,1307) = lu(k,1307) - lu(k,1287) * lu(k,1306) + lu(k,1307) = 1._r8 / lu(k,1307) + end do + end subroutine lu_fac18 + subroutine lu_fac( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) + call lu_fac01( avec_len, lu ) + call lu_fac02( avec_len, lu ) + call lu_fac03( avec_len, lu ) + call lu_fac04( avec_len, lu ) + call lu_fac05( avec_len, lu ) + call lu_fac06( avec_len, lu ) + call lu_fac07( avec_len, lu ) + call lu_fac08( avec_len, lu ) + call lu_fac09( avec_len, lu ) + call lu_fac10( avec_len, lu ) + call lu_fac11( avec_len, lu ) + call lu_fac12( avec_len, lu ) + call lu_fac13( avec_len, lu ) + call lu_fac14( avec_len, lu ) + call lu_fac15( avec_len, lu ) + call lu_fac16( avec_len, lu ) + call lu_fac17( avec_len, lu ) + call lu_fac18( avec_len, lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_lu_solve.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_lu_solve.F90 new file mode 100644 index 0000000000..fa84d27128 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_lu_solve.F90 @@ -0,0 +1,1495 @@ + module mo_lu_solve + use chem_mods, only: veclen + private + public :: lu_slv + contains + subroutine lu_slv01( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,124) = b(k,124) - lu(k,10) * b(k,9) + b(k,32) = b(k,32) - lu(k,33) * b(k,31) + b(k,128) = b(k,128) - lu(k,37) * b(k,34) + b(k,137) = b(k,137) - lu(k,38) * b(k,34) + b(k,98) = b(k,98) - lu(k,40) * b(k,35) + b(k,135) = b(k,135) - lu(k,41) * b(k,35) + b(k,126) = b(k,126) - lu(k,43) * b(k,36) + b(k,134) = b(k,134) - lu(k,44) * b(k,36) + b(k,135) = b(k,135) - lu(k,46) * b(k,37) + b(k,139) = b(k,139) - lu(k,47) * b(k,37) + b(k,128) = b(k,128) - lu(k,49) * b(k,38) + b(k,134) = b(k,134) - lu(k,50) * b(k,38) + b(k,126) = b(k,126) - lu(k,52) * b(k,39) + b(k,134) = b(k,134) - lu(k,53) * b(k,39) + b(k,128) = b(k,128) - lu(k,55) * b(k,40) + b(k,134) = b(k,134) - lu(k,56) * b(k,40) + b(k,128) = b(k,128) - lu(k,58) * b(k,41) + b(k,134) = b(k,134) - lu(k,59) * b(k,41) + b(k,128) = b(k,128) - lu(k,61) * b(k,42) + b(k,134) = b(k,134) - lu(k,62) * b(k,42) + b(k,128) = b(k,128) - lu(k,64) * b(k,43) + b(k,134) = b(k,134) - lu(k,65) * b(k,43) + b(k,128) = b(k,128) - lu(k,67) * b(k,44) + b(k,134) = b(k,134) - lu(k,68) * b(k,44) + b(k,98) = b(k,98) - lu(k,70) * b(k,45) + b(k,135) = b(k,135) - lu(k,71) * b(k,45) + b(k,139) = b(k,139) - lu(k,72) * b(k,45) + b(k,126) = b(k,126) - lu(k,74) * b(k,46) + b(k,128) = b(k,128) - lu(k,75) * b(k,46) + b(k,134) = b(k,134) - lu(k,76) * b(k,46) + b(k,128) = b(k,128) - lu(k,78) * b(k,47) + b(k,135) = b(k,135) - lu(k,79) * b(k,47) + b(k,139) = b(k,139) - lu(k,80) * b(k,47) + b(k,59) = b(k,59) - lu(k,82) * b(k,48) + b(k,135) = b(k,135) - lu(k,83) * b(k,48) + b(k,58) = b(k,58) - lu(k,85) * b(k,49) + b(k,139) = b(k,139) - lu(k,86) * b(k,49) + b(k,128) = b(k,128) - lu(k,88) * b(k,50) + b(k,128) = b(k,128) - lu(k,90) * b(k,51) + b(k,134) = b(k,134) - lu(k,91) * b(k,51) + b(k,135) = b(k,135) - lu(k,92) * b(k,51) + b(k,128) = b(k,128) - lu(k,94) * b(k,52) + b(k,134) = b(k,134) - lu(k,95) * b(k,52) + b(k,135) = b(k,135) - lu(k,96) * b(k,52) + b(k,134) = b(k,134) - lu(k,98) * b(k,53) + b(k,138) = b(k,138) - lu(k,99) * b(k,53) + b(k,115) = b(k,115) - lu(k,101) * b(k,54) + b(k,135) = b(k,135) - lu(k,102) * b(k,54) + b(k,128) = b(k,128) - lu(k,104) * b(k,55) + b(k,134) = b(k,134) - lu(k,105) * b(k,55) + b(k,135) = b(k,135) - lu(k,106) * b(k,55) + b(k,139) = b(k,139) - lu(k,107) * b(k,55) + b(k,126) = b(k,126) - lu(k,109) * b(k,56) + b(k,128) = b(k,128) - lu(k,110) * b(k,56) + b(k,113) = b(k,113) - lu(k,112) * b(k,57) + b(k,130) = b(k,130) - lu(k,113) * b(k,57) + b(k,135) = b(k,135) - lu(k,114) * b(k,57) + b(k,102) = b(k,102) - lu(k,117) * b(k,58) + b(k,129) = b(k,129) - lu(k,118) * b(k,58) + b(k,139) = b(k,139) - lu(k,119) * b(k,58) + b(k,105) = b(k,105) - lu(k,121) * b(k,59) + b(k,125) = b(k,125) - lu(k,122) * b(k,59) + b(k,130) = b(k,130) - lu(k,123) * b(k,59) + b(k,101) = b(k,101) - lu(k,125) * b(k,60) + b(k,129) = b(k,129) - lu(k,126) * b(k,60) + b(k,133) = b(k,133) - lu(k,127) * b(k,60) + b(k,136) = b(k,136) - lu(k,128) * b(k,60) + b(k,138) = b(k,138) - lu(k,129) * b(k,60) + b(k,96) = b(k,96) - lu(k,131) * b(k,61) + b(k,127) = b(k,127) - lu(k,132) * b(k,61) + b(k,128) = b(k,128) - lu(k,133) * b(k,61) + b(k,135) = b(k,135) - lu(k,134) * b(k,61) + b(k,139) = b(k,139) - lu(k,135) * b(k,61) + b(k,101) = b(k,101) - lu(k,137) * b(k,62) + b(k,102) = b(k,102) - lu(k,138) * b(k,62) + b(k,130) = b(k,130) - lu(k,139) * b(k,62) + b(k,135) = b(k,135) - lu(k,140) * b(k,62) + b(k,136) = b(k,136) - lu(k,141) * b(k,62) + b(k,119) = b(k,119) - lu(k,143) * b(k,63) + b(k,120) = b(k,120) - lu(k,144) * b(k,63) + b(k,130) = b(k,130) - lu(k,145) * b(k,63) + b(k,135) = b(k,135) - lu(k,146) * b(k,63) + b(k,96) = b(k,96) - lu(k,148) * b(k,64) + b(k,113) = b(k,113) - lu(k,149) * b(k,64) + b(k,130) = b(k,130) - lu(k,150) * b(k,64) + b(k,135) = b(k,135) - lu(k,151) * b(k,64) + b(k,102) = b(k,102) - lu(k,153) * b(k,65) + b(k,117) = b(k,117) - lu(k,154) * b(k,65) + b(k,129) = b(k,129) - lu(k,155) * b(k,65) + b(k,137) = b(k,137) - lu(k,156) * b(k,65) + b(k,115) = b(k,115) - lu(k,158) * b(k,66) + b(k,135) = b(k,135) - lu(k,159) * b(k,66) + b(k,78) = b(k,78) - lu(k,161) * b(k,67) + b(k,102) = b(k,102) - lu(k,162) * b(k,67) + b(k,110) = b(k,110) - lu(k,163) * b(k,67) + b(k,117) = b(k,117) - lu(k,164) * b(k,67) + b(k,124) = b(k,124) - lu(k,165) * b(k,67) + b(k,129) = b(k,129) - lu(k,166) * b(k,67) + b(k,135) = b(k,135) - lu(k,167) * b(k,67) + b(k,110) = b(k,110) - lu(k,169) * b(k,68) + b(k,123) = b(k,123) - lu(k,170) * b(k,68) + b(k,127) = b(k,127) - lu(k,171) * b(k,68) + b(k,128) = b(k,128) - lu(k,172) * b(k,68) + b(k,130) = b(k,130) - lu(k,173) * b(k,68) + b(k,135) = b(k,135) - lu(k,174) * b(k,68) + b(k,139) = b(k,139) - lu(k,175) * b(k,68) + b(k,130) = b(k,130) - lu(k,177) * b(k,69) + b(k,133) = b(k,133) - lu(k,178) * b(k,69) + b(k,135) = b(k,135) - lu(k,179) * b(k,69) + b(k,136) = b(k,136) - lu(k,180) * b(k,69) + b(k,139) = b(k,139) - lu(k,181) * b(k,69) + b(k,126) = b(k,126) - lu(k,183) * b(k,70) + b(k,127) = b(k,127) - lu(k,184) * b(k,70) + b(k,128) = b(k,128) - lu(k,185) * b(k,70) + b(k,134) = b(k,134) - lu(k,186) * b(k,70) + b(k,135) = b(k,135) - lu(k,187) * b(k,70) + b(k,95) = b(k,95) - lu(k,189) * b(k,71) + b(k,98) = b(k,98) - lu(k,190) * b(k,71) + b(k,130) = b(k,130) - lu(k,191) * b(k,71) + b(k,135) = b(k,135) - lu(k,192) * b(k,71) + b(k,139) = b(k,139) - lu(k,193) * b(k,71) + b(k,116) = b(k,116) - lu(k,195) * b(k,72) + b(k,121) = b(k,121) - lu(k,196) * b(k,72) + b(k,125) = b(k,125) - lu(k,197) * b(k,72) + b(k,133) = b(k,133) - lu(k,198) * b(k,72) + b(k,135) = b(k,135) - lu(k,199) * b(k,72) + b(k,123) = b(k,123) - lu(k,201) * b(k,73) + b(k,124) = b(k,124) - lu(k,202) * b(k,73) + b(k,125) = b(k,125) - lu(k,203) * b(k,73) + b(k,135) = b(k,135) - lu(k,204) * b(k,73) + b(k,139) = b(k,139) - lu(k,205) * b(k,73) + b(k,108) = b(k,108) - lu(k,207) * b(k,74) + b(k,121) = b(k,121) - lu(k,208) * b(k,74) + b(k,125) = b(k,125) - lu(k,209) * b(k,74) + b(k,135) = b(k,135) - lu(k,210) * b(k,74) + b(k,139) = b(k,139) - lu(k,211) * b(k,74) + b(k,124) = b(k,124) - lu(k,214) * b(k,75) + b(k,129) = b(k,129) - lu(k,215) * b(k,75) + b(k,133) = b(k,133) - lu(k,216) * b(k,75) + b(k,134) = b(k,134) - lu(k,217) * b(k,75) + b(k,135) = b(k,135) - lu(k,218) * b(k,75) + b(k,138) = b(k,138) - lu(k,219) * b(k,75) + b(k,91) = b(k,91) - lu(k,221) * b(k,76) + b(k,110) = b(k,110) - lu(k,222) * b(k,76) + b(k,125) = b(k,125) - lu(k,223) * b(k,76) + b(k,130) = b(k,130) - lu(k,224) * b(k,76) + b(k,132) = b(k,132) - lu(k,225) * b(k,76) + b(k,135) = b(k,135) - lu(k,226) * b(k,76) + b(k,126) = b(k,126) - lu(k,228) * b(k,77) + b(k,127) = b(k,127) - lu(k,229) * b(k,77) + b(k,128) = b(k,128) - lu(k,230) * b(k,77) + b(k,134) = b(k,134) - lu(k,231) * b(k,77) + b(k,135) = b(k,135) - lu(k,232) * b(k,77) + b(k,139) = b(k,139) - lu(k,233) * b(k,77) + b(k,117) = b(k,117) - lu(k,235) * b(k,78) + b(k,124) = b(k,124) - lu(k,236) * b(k,78) + b(k,129) = b(k,129) - lu(k,237) * b(k,78) + b(k,132) = b(k,132) - lu(k,238) * b(k,78) + b(k,135) = b(k,135) - lu(k,239) * b(k,78) + b(k,114) = b(k,114) - lu(k,241) * b(k,79) + b(k,115) = b(k,115) - lu(k,242) * b(k,79) + b(k,118) = b(k,118) - lu(k,243) * b(k,79) + b(k,122) = b(k,122) - lu(k,244) * b(k,79) + b(k,125) = b(k,125) - lu(k,245) * b(k,79) + b(k,130) = b(k,130) - lu(k,246) * b(k,79) + b(k,135) = b(k,135) - lu(k,247) * b(k,79) + b(k,125) = b(k,125) - lu(k,249) * b(k,80) + b(k,130) = b(k,130) - lu(k,250) * b(k,80) + b(k,135) = b(k,135) - lu(k,251) * b(k,80) + b(k,90) = b(k,90) - lu(k,253) * b(k,81) + b(k,121) = b(k,121) - lu(k,254) * b(k,81) + b(k,123) = b(k,123) - lu(k,255) * b(k,81) + b(k,125) = b(k,125) - lu(k,256) * b(k,81) + b(k,133) = b(k,133) - lu(k,257) * b(k,81) + b(k,135) = b(k,135) - lu(k,258) * b(k,81) + b(k,136) = b(k,136) - lu(k,259) * b(k,81) + b(k,93) = b(k,93) - lu(k,261) * b(k,82) + b(k,109) = b(k,109) - lu(k,262) * b(k,82) + b(k,113) = b(k,113) - lu(k,263) * b(k,82) + b(k,125) = b(k,125) - lu(k,264) * b(k,82) + b(k,130) = b(k,130) - lu(k,265) * b(k,82) + b(k,135) = b(k,135) - lu(k,266) * b(k,82) + b(k,139) = b(k,139) - lu(k,267) * b(k,82) + b(k,94) = b(k,94) - lu(k,269) * b(k,83) + b(k,101) = b(k,101) - lu(k,270) * b(k,83) + b(k,126) = b(k,126) - lu(k,271) * b(k,83) + b(k,129) = b(k,129) - lu(k,272) * b(k,83) + b(k,131) = b(k,131) - lu(k,273) * b(k,83) + b(k,133) = b(k,133) - lu(k,274) * b(k,83) + b(k,136) = b(k,136) - lu(k,275) * b(k,83) + b(k,127) = b(k,127) - lu(k,277) * b(k,84) + b(k,128) = b(k,128) - lu(k,278) * b(k,84) + b(k,129) = b(k,129) - lu(k,279) * b(k,84) + b(k,130) = b(k,130) - lu(k,280) * b(k,84) + b(k,135) = b(k,135) - lu(k,281) * b(k,84) + b(k,139) = b(k,139) - lu(k,282) * b(k,84) + b(k,90) = b(k,90) - lu(k,284) * b(k,85) + b(k,109) = b(k,109) - lu(k,285) * b(k,85) + b(k,120) = b(k,120) - lu(k,286) * b(k,85) + b(k,125) = b(k,125) - lu(k,287) * b(k,85) + b(k,130) = b(k,130) - lu(k,288) * b(k,85) + b(k,133) = b(k,133) - lu(k,289) * b(k,85) + b(k,135) = b(k,135) - lu(k,290) * b(k,85) + b(k,136) = b(k,136) - lu(k,291) * b(k,85) + end do + end subroutine lu_slv01 + subroutine lu_slv02( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,123) = b(k,123) - lu(k,293) * b(k,86) + b(k,126) = b(k,126) - lu(k,294) * b(k,86) + b(k,127) = b(k,127) - lu(k,295) * b(k,86) + b(k,128) = b(k,128) - lu(k,296) * b(k,86) + b(k,130) = b(k,130) - lu(k,297) * b(k,86) + b(k,134) = b(k,134) - lu(k,298) * b(k,86) + b(k,135) = b(k,135) - lu(k,299) * b(k,86) + b(k,139) = b(k,139) - lu(k,300) * b(k,86) + b(k,90) = b(k,90) - lu(k,302) * b(k,87) + b(k,121) = b(k,121) - lu(k,303) * b(k,87) + b(k,123) = b(k,123) - lu(k,304) * b(k,87) + b(k,125) = b(k,125) - lu(k,305) * b(k,87) + b(k,135) = b(k,135) - lu(k,306) * b(k,87) + b(k,139) = b(k,139) - lu(k,307) * b(k,87) + b(k,95) = b(k,95) - lu(k,309) * b(k,88) + b(k,114) = b(k,114) - lu(k,310) * b(k,88) + b(k,118) = b(k,118) - lu(k,311) * b(k,88) + b(k,122) = b(k,122) - lu(k,312) * b(k,88) + b(k,129) = b(k,129) - lu(k,313) * b(k,88) + b(k,132) = b(k,132) - lu(k,314) * b(k,88) + b(k,133) = b(k,133) - lu(k,315) * b(k,88) + b(k,135) = b(k,135) - lu(k,316) * b(k,88) + b(k,136) = b(k,136) - lu(k,317) * b(k,88) + b(k,90) = b(k,90) - lu(k,319) * b(k,89) + b(k,123) = b(k,123) - lu(k,320) * b(k,89) + b(k,135) = b(k,135) - lu(k,321) * b(k,89) + b(k,139) = b(k,139) - lu(k,322) * b(k,89) + b(k,110) = b(k,110) - lu(k,324) * b(k,90) + b(k,129) = b(k,129) - lu(k,325) * b(k,90) + b(k,105) = b(k,105) - lu(k,329) * b(k,91) + b(k,125) = b(k,125) - lu(k,330) * b(k,91) + b(k,130) = b(k,130) - lu(k,331) * b(k,91) + b(k,133) = b(k,133) - lu(k,332) * b(k,91) + b(k,135) = b(k,135) - lu(k,333) * b(k,91) + b(k,138) = b(k,138) - lu(k,334) * b(k,91) + b(k,110) = b(k,110) - lu(k,337) * b(k,92) + b(k,129) = b(k,129) - lu(k,338) * b(k,92) + b(k,130) = b(k,130) - lu(k,339) * b(k,92) + b(k,135) = b(k,135) - lu(k,340) * b(k,92) + b(k,109) = b(k,109) - lu(k,343) * b(k,93) + b(k,113) = b(k,113) - lu(k,344) * b(k,93) + b(k,125) = b(k,125) - lu(k,345) * b(k,93) + b(k,130) = b(k,130) - lu(k,346) * b(k,93) + b(k,133) = b(k,133) - lu(k,347) * b(k,93) + b(k,135) = b(k,135) - lu(k,348) * b(k,93) + b(k,138) = b(k,138) - lu(k,349) * b(k,93) + b(k,139) = b(k,139) - lu(k,350) * b(k,93) + b(k,126) = b(k,126) - lu(k,353) * b(k,94) + b(k,127) = b(k,127) - lu(k,354) * b(k,94) + b(k,128) = b(k,128) - lu(k,355) * b(k,94) + b(k,129) = b(k,129) - lu(k,356) * b(k,94) + b(k,131) = b(k,131) - lu(k,357) * b(k,94) + b(k,135) = b(k,135) - lu(k,358) * b(k,94) + b(k,139) = b(k,139) - lu(k,359) * b(k,94) + b(k,108) = b(k,108) - lu(k,361) * b(k,95) + b(k,121) = b(k,121) - lu(k,362) * b(k,95) + b(k,123) = b(k,123) - lu(k,363) * b(k,95) + b(k,135) = b(k,135) - lu(k,364) * b(k,95) + b(k,139) = b(k,139) - lu(k,365) * b(k,95) + b(k,113) = b(k,113) - lu(k,370) * b(k,96) + b(k,123) = b(k,123) - lu(k,371) * b(k,96) + b(k,125) = b(k,125) - lu(k,372) * b(k,96) + b(k,130) = b(k,130) - lu(k,373) * b(k,96) + b(k,133) = b(k,133) - lu(k,374) * b(k,96) + b(k,135) = b(k,135) - lu(k,375) * b(k,96) + b(k,138) = b(k,138) - lu(k,376) * b(k,96) + b(k,106) = b(k,106) - lu(k,378) * b(k,97) + b(k,114) = b(k,114) - lu(k,379) * b(k,97) + b(k,122) = b(k,122) - lu(k,380) * b(k,97) + b(k,125) = b(k,125) - lu(k,381) * b(k,97) + b(k,130) = b(k,130) - lu(k,382) * b(k,97) + b(k,133) = b(k,133) - lu(k,383) * b(k,97) + b(k,135) = b(k,135) - lu(k,384) * b(k,97) + b(k,136) = b(k,136) - lu(k,385) * b(k,97) + b(k,138) = b(k,138) - lu(k,386) * b(k,97) + b(k,108) = b(k,108) - lu(k,390) * b(k,98) + b(k,113) = b(k,113) - lu(k,391) * b(k,98) + b(k,121) = b(k,121) - lu(k,392) * b(k,98) + b(k,123) = b(k,123) - lu(k,393) * b(k,98) + b(k,125) = b(k,125) - lu(k,394) * b(k,98) + b(k,130) = b(k,130) - lu(k,395) * b(k,98) + b(k,133) = b(k,133) - lu(k,396) * b(k,98) + b(k,135) = b(k,135) - lu(k,397) * b(k,98) + b(k,138) = b(k,138) - lu(k,398) * b(k,98) + b(k,139) = b(k,139) - lu(k,399) * b(k,98) + b(k,127) = b(k,127) - lu(k,402) * b(k,99) + b(k,128) = b(k,128) - lu(k,403) * b(k,99) + b(k,129) = b(k,129) - lu(k,404) * b(k,99) + b(k,135) = b(k,135) - lu(k,405) * b(k,99) + b(k,137) = b(k,137) - lu(k,406) * b(k,99) + b(k,139) = b(k,139) - lu(k,407) * b(k,99) + b(k,124) = b(k,124) - lu(k,409) * b(k,100) + b(k,126) = b(k,126) - lu(k,410) * b(k,100) + b(k,129) = b(k,129) - lu(k,411) * b(k,100) + b(k,131) = b(k,131) - lu(k,412) * b(k,100) + b(k,134) = b(k,134) - lu(k,413) * b(k,100) + b(k,135) = b(k,135) - lu(k,414) * b(k,100) + b(k,139) = b(k,139) - lu(k,415) * b(k,100) + b(k,133) = b(k,133) - lu(k,417) * b(k,101) + b(k,135) = b(k,135) - lu(k,418) * b(k,101) + b(k,136) = b(k,136) - lu(k,419) * b(k,101) + b(k,139) = b(k,139) - lu(k,420) * b(k,101) + b(k,117) = b(k,117) - lu(k,423) * b(k,102) + b(k,129) = b(k,129) - lu(k,424) * b(k,102) + b(k,130) = b(k,130) - lu(k,425) * b(k,102) + b(k,135) = b(k,135) - lu(k,426) * b(k,102) + b(k,139) = b(k,139) - lu(k,427) * b(k,102) + b(k,106) = b(k,106) - lu(k,430) * b(k,103) + b(k,110) = b(k,110) - lu(k,431) * b(k,103) + b(k,112) = b(k,112) - lu(k,432) * b(k,103) + b(k,114) = b(k,114) - lu(k,433) * b(k,103) + b(k,118) = b(k,118) - lu(k,434) * b(k,103) + b(k,121) = b(k,121) - lu(k,435) * b(k,103) + b(k,122) = b(k,122) - lu(k,436) * b(k,103) + b(k,123) = b(k,123) - lu(k,437) * b(k,103) + b(k,125) = b(k,125) - lu(k,438) * b(k,103) + b(k,130) = b(k,130) - lu(k,439) * b(k,103) + b(k,132) = b(k,132) - lu(k,440) * b(k,103) + b(k,133) = b(k,133) - lu(k,441) * b(k,103) + b(k,135) = b(k,135) - lu(k,442) * b(k,103) + b(k,136) = b(k,136) - lu(k,443) * b(k,103) + b(k,138) = b(k,138) - lu(k,444) * b(k,103) + b(k,127) = b(k,127) - lu(k,449) * b(k,104) + b(k,128) = b(k,128) - lu(k,450) * b(k,104) + b(k,129) = b(k,129) - lu(k,451) * b(k,104) + b(k,133) = b(k,133) - lu(k,452) * b(k,104) + b(k,135) = b(k,135) - lu(k,453) * b(k,104) + b(k,136) = b(k,136) - lu(k,454) * b(k,104) + b(k,137) = b(k,137) - lu(k,455) * b(k,104) + b(k,139) = b(k,139) - lu(k,456) * b(k,104) + b(k,110) = b(k,110) - lu(k,460) * b(k,105) + b(k,125) = b(k,125) - lu(k,461) * b(k,105) + b(k,129) = b(k,129) - lu(k,462) * b(k,105) + b(k,130) = b(k,130) - lu(k,463) * b(k,105) + b(k,135) = b(k,135) - lu(k,464) * b(k,105) + b(k,110) = b(k,110) - lu(k,468) * b(k,106) + b(k,115) = b(k,115) - lu(k,469) * b(k,106) + b(k,125) = b(k,125) - lu(k,470) * b(k,106) + b(k,130) = b(k,130) - lu(k,471) * b(k,106) + b(k,133) = b(k,133) - lu(k,472) * b(k,106) + b(k,135) = b(k,135) - lu(k,473) * b(k,106) + b(k,136) = b(k,136) - lu(k,474) * b(k,106) + b(k,139) = b(k,139) - lu(k,475) * b(k,106) + b(k,110) = b(k,110) - lu(k,478) * b(k,107) + b(k,111) = b(k,111) - lu(k,479) * b(k,107) + b(k,123) = b(k,123) - lu(k,480) * b(k,107) + b(k,124) = b(k,124) - lu(k,481) * b(k,107) + b(k,125) = b(k,125) - lu(k,482) * b(k,107) + b(k,127) = b(k,127) - lu(k,483) * b(k,107) + b(k,128) = b(k,128) - lu(k,484) * b(k,107) + b(k,129) = b(k,129) - lu(k,485) * b(k,107) + b(k,130) = b(k,130) - lu(k,486) * b(k,107) + b(k,134) = b(k,134) - lu(k,487) * b(k,107) + b(k,135) = b(k,135) - lu(k,488) * b(k,107) + b(k,139) = b(k,139) - lu(k,489) * b(k,107) + b(k,109) = b(k,109) - lu(k,493) * b(k,108) + b(k,116) = b(k,116) - lu(k,494) * b(k,108) + b(k,121) = b(k,121) - lu(k,495) * b(k,108) + b(k,123) = b(k,123) - lu(k,496) * b(k,108) + b(k,125) = b(k,125) - lu(k,497) * b(k,108) + b(k,130) = b(k,130) - lu(k,498) * b(k,108) + b(k,133) = b(k,133) - lu(k,499) * b(k,108) + b(k,135) = b(k,135) - lu(k,500) * b(k,108) + b(k,138) = b(k,138) - lu(k,501) * b(k,108) + b(k,139) = b(k,139) - lu(k,502) * b(k,108) + b(k,116) = b(k,116) - lu(k,504) * b(k,109) + b(k,121) = b(k,121) - lu(k,505) * b(k,109) + b(k,125) = b(k,125) - lu(k,506) * b(k,109) + b(k,130) = b(k,130) - lu(k,507) * b(k,109) + b(k,135) = b(k,135) - lu(k,508) * b(k,109) + b(k,129) = b(k,129) - lu(k,511) * b(k,110) + b(k,130) = b(k,130) - lu(k,512) * b(k,110) + b(k,135) = b(k,135) - lu(k,513) * b(k,110) + b(k,124) = b(k,124) - lu(k,515) * b(k,111) + b(k,127) = b(k,127) - lu(k,516) * b(k,111) + b(k,128) = b(k,128) - lu(k,517) * b(k,111) + b(k,129) = b(k,129) - lu(k,518) * b(k,111) + b(k,134) = b(k,134) - lu(k,519) * b(k,111) + b(k,135) = b(k,135) - lu(k,520) * b(k,111) + b(k,139) = b(k,139) - lu(k,521) * b(k,111) + b(k,113) = b(k,113) - lu(k,531) * b(k,112) + b(k,116) = b(k,116) - lu(k,532) * b(k,112) + b(k,121) = b(k,121) - lu(k,533) * b(k,112) + b(k,123) = b(k,123) - lu(k,534) * b(k,112) + b(k,124) = b(k,124) - lu(k,535) * b(k,112) + b(k,125) = b(k,125) - lu(k,536) * b(k,112) + b(k,127) = b(k,127) - lu(k,537) * b(k,112) + b(k,128) = b(k,128) - lu(k,538) * b(k,112) + b(k,129) = b(k,129) - lu(k,539) * b(k,112) + b(k,130) = b(k,130) - lu(k,540) * b(k,112) + b(k,132) = b(k,132) - lu(k,541) * b(k,112) + b(k,133) = b(k,133) - lu(k,542) * b(k,112) + b(k,134) = b(k,134) - lu(k,543) * b(k,112) + b(k,135) = b(k,135) - lu(k,544) * b(k,112) + b(k,136) = b(k,136) - lu(k,545) * b(k,112) + b(k,138) = b(k,138) - lu(k,546) * b(k,112) + b(k,139) = b(k,139) - lu(k,547) * b(k,112) + b(k,121) = b(k,121) - lu(k,551) * b(k,113) + b(k,123) = b(k,123) - lu(k,552) * b(k,113) + b(k,129) = b(k,129) - lu(k,553) * b(k,113) + b(k,130) = b(k,130) - lu(k,554) * b(k,113) + b(k,133) = b(k,133) - lu(k,555) * b(k,113) + b(k,135) = b(k,135) - lu(k,556) * b(k,113) + b(k,136) = b(k,136) - lu(k,557) * b(k,113) + b(k,139) = b(k,139) - lu(k,558) * b(k,113) + end do + end subroutine lu_slv02 + subroutine lu_slv03( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,116) = b(k,116) - lu(k,561) * b(k,114) + b(k,119) = b(k,119) - lu(k,562) * b(k,114) + b(k,120) = b(k,120) - lu(k,563) * b(k,114) + b(k,121) = b(k,121) - lu(k,564) * b(k,114) + b(k,125) = b(k,125) - lu(k,565) * b(k,114) + b(k,129) = b(k,129) - lu(k,566) * b(k,114) + b(k,130) = b(k,130) - lu(k,567) * b(k,114) + b(k,132) = b(k,132) - lu(k,568) * b(k,114) + b(k,135) = b(k,135) - lu(k,569) * b(k,114) + b(k,139) = b(k,139) - lu(k,570) * b(k,114) + b(k,116) = b(k,116) - lu(k,579) * b(k,115) + b(k,121) = b(k,121) - lu(k,580) * b(k,115) + b(k,123) = b(k,123) - lu(k,581) * b(k,115) + b(k,125) = b(k,125) - lu(k,582) * b(k,115) + b(k,129) = b(k,129) - lu(k,583) * b(k,115) + b(k,130) = b(k,130) - lu(k,584) * b(k,115) + b(k,133) = b(k,133) - lu(k,585) * b(k,115) + b(k,135) = b(k,135) - lu(k,586) * b(k,115) + b(k,136) = b(k,136) - lu(k,587) * b(k,115) + b(k,138) = b(k,138) - lu(k,588) * b(k,115) + b(k,121) = b(k,121) - lu(k,592) * b(k,116) + b(k,129) = b(k,129) - lu(k,593) * b(k,116) + b(k,130) = b(k,130) - lu(k,594) * b(k,116) + b(k,133) = b(k,133) - lu(k,595) * b(k,116) + b(k,135) = b(k,135) - lu(k,596) * b(k,116) + b(k,136) = b(k,136) - lu(k,597) * b(k,116) + b(k,139) = b(k,139) - lu(k,598) * b(k,116) + b(k,124) = b(k,124) - lu(k,603) * b(k,117) + b(k,126) = b(k,126) - lu(k,604) * b(k,117) + b(k,128) = b(k,128) - lu(k,605) * b(k,117) + b(k,129) = b(k,129) - lu(k,606) * b(k,117) + b(k,130) = b(k,130) - lu(k,607) * b(k,117) + b(k,131) = b(k,131) - lu(k,608) * b(k,117) + b(k,132) = b(k,132) - lu(k,609) * b(k,117) + b(k,133) = b(k,133) - lu(k,610) * b(k,117) + b(k,135) = b(k,135) - lu(k,611) * b(k,117) + b(k,137) = b(k,137) - lu(k,612) * b(k,117) + b(k,138) = b(k,138) - lu(k,613) * b(k,117) + b(k,139) = b(k,139) - lu(k,614) * b(k,117) + b(k,119) = b(k,119) - lu(k,627) * b(k,118) + b(k,120) = b(k,120) - lu(k,628) * b(k,118) + b(k,121) = b(k,121) - lu(k,629) * b(k,118) + b(k,122) = b(k,122) - lu(k,630) * b(k,118) + b(k,123) = b(k,123) - lu(k,631) * b(k,118) + b(k,125) = b(k,125) - lu(k,632) * b(k,118) + b(k,129) = b(k,129) - lu(k,633) * b(k,118) + b(k,130) = b(k,130) - lu(k,634) * b(k,118) + b(k,132) = b(k,132) - lu(k,635) * b(k,118) + b(k,133) = b(k,133) - lu(k,636) * b(k,118) + b(k,135) = b(k,135) - lu(k,637) * b(k,118) + b(k,136) = b(k,136) - lu(k,638) * b(k,118) + b(k,138) = b(k,138) - lu(k,639) * b(k,118) + b(k,139) = b(k,139) - lu(k,640) * b(k,118) + b(k,120) = b(k,120) - lu(k,650) * b(k,119) + b(k,121) = b(k,121) - lu(k,651) * b(k,119) + b(k,123) = b(k,123) - lu(k,652) * b(k,119) + b(k,125) = b(k,125) - lu(k,653) * b(k,119) + b(k,129) = b(k,129) - lu(k,654) * b(k,119) + b(k,130) = b(k,130) - lu(k,655) * b(k,119) + b(k,133) = b(k,133) - lu(k,656) * b(k,119) + b(k,135) = b(k,135) - lu(k,657) * b(k,119) + b(k,136) = b(k,136) - lu(k,658) * b(k,119) + b(k,138) = b(k,138) - lu(k,659) * b(k,119) + b(k,139) = b(k,139) - lu(k,660) * b(k,119) + b(k,121) = b(k,121) - lu(k,669) * b(k,120) + b(k,123) = b(k,123) - lu(k,670) * b(k,120) + b(k,125) = b(k,125) - lu(k,671) * b(k,120) + b(k,129) = b(k,129) - lu(k,672) * b(k,120) + b(k,130) = b(k,130) - lu(k,673) * b(k,120) + b(k,132) = b(k,132) - lu(k,674) * b(k,120) + b(k,133) = b(k,133) - lu(k,675) * b(k,120) + b(k,135) = b(k,135) - lu(k,676) * b(k,120) + b(k,136) = b(k,136) - lu(k,677) * b(k,120) + b(k,138) = b(k,138) - lu(k,678) * b(k,120) + b(k,139) = b(k,139) - lu(k,679) * b(k,120) + b(k,122) = b(k,122) - lu(k,696) * b(k,121) + b(k,123) = b(k,123) - lu(k,697) * b(k,121) + b(k,125) = b(k,125) - lu(k,698) * b(k,121) + b(k,129) = b(k,129) - lu(k,699) * b(k,121) + b(k,130) = b(k,130) - lu(k,700) * b(k,121) + b(k,132) = b(k,132) - lu(k,701) * b(k,121) + b(k,133) = b(k,133) - lu(k,702) * b(k,121) + b(k,135) = b(k,135) - lu(k,703) * b(k,121) + b(k,136) = b(k,136) - lu(k,704) * b(k,121) + b(k,138) = b(k,138) - lu(k,705) * b(k,121) + b(k,139) = b(k,139) - lu(k,706) * b(k,121) + b(k,123) = b(k,123) - lu(k,716) * b(k,122) + b(k,124) = b(k,124) - lu(k,717) * b(k,122) + b(k,125) = b(k,125) - lu(k,718) * b(k,122) + b(k,127) = b(k,127) - lu(k,719) * b(k,122) + b(k,128) = b(k,128) - lu(k,720) * b(k,122) + b(k,129) = b(k,129) - lu(k,721) * b(k,122) + b(k,130) = b(k,130) - lu(k,722) * b(k,122) + b(k,132) = b(k,132) - lu(k,723) * b(k,122) + b(k,133) = b(k,133) - lu(k,724) * b(k,122) + b(k,134) = b(k,134) - lu(k,725) * b(k,122) + b(k,135) = b(k,135) - lu(k,726) * b(k,122) + b(k,136) = b(k,136) - lu(k,727) * b(k,122) + b(k,138) = b(k,138) - lu(k,728) * b(k,122) + b(k,139) = b(k,139) - lu(k,729) * b(k,122) + b(k,124) = b(k,124) - lu(k,754) * b(k,123) + b(k,125) = b(k,125) - lu(k,755) * b(k,123) + b(k,127) = b(k,127) - lu(k,756) * b(k,123) + b(k,128) = b(k,128) - lu(k,757) * b(k,123) + b(k,129) = b(k,129) - lu(k,758) * b(k,123) + b(k,130) = b(k,130) - lu(k,759) * b(k,123) + b(k,132) = b(k,132) - lu(k,760) * b(k,123) + b(k,133) = b(k,133) - lu(k,761) * b(k,123) + b(k,134) = b(k,134) - lu(k,762) * b(k,123) + b(k,135) = b(k,135) - lu(k,763) * b(k,123) + b(k,136) = b(k,136) - lu(k,764) * b(k,123) + b(k,137) = b(k,137) - lu(k,765) * b(k,123) + b(k,138) = b(k,138) - lu(k,766) * b(k,123) + b(k,139) = b(k,139) - lu(k,767) * b(k,123) + b(k,127) = b(k,127) - lu(k,770) * b(k,124) + b(k,128) = b(k,128) - lu(k,771) * b(k,124) + b(k,129) = b(k,129) - lu(k,772) * b(k,124) + b(k,130) = b(k,130) - lu(k,773) * b(k,124) + b(k,132) = b(k,132) - lu(k,774) * b(k,124) + b(k,134) = b(k,134) - lu(k,775) * b(k,124) + b(k,135) = b(k,135) - lu(k,776) * b(k,124) + b(k,139) = b(k,139) - lu(k,777) * b(k,124) + b(k,126) = b(k,126) - lu(k,784) * b(k,125) + b(k,127) = b(k,127) - lu(k,785) * b(k,125) + b(k,128) = b(k,128) - lu(k,786) * b(k,125) + b(k,129) = b(k,129) - lu(k,787) * b(k,125) + b(k,130) = b(k,130) - lu(k,788) * b(k,125) + b(k,131) = b(k,131) - lu(k,789) * b(k,125) + b(k,132) = b(k,132) - lu(k,790) * b(k,125) + b(k,133) = b(k,133) - lu(k,791) * b(k,125) + b(k,134) = b(k,134) - lu(k,792) * b(k,125) + b(k,135) = b(k,135) - lu(k,793) * b(k,125) + b(k,136) = b(k,136) - lu(k,794) * b(k,125) + b(k,139) = b(k,139) - lu(k,795) * b(k,125) + b(k,127) = b(k,127) - lu(k,801) * b(k,126) + b(k,128) = b(k,128) - lu(k,802) * b(k,126) + b(k,129) = b(k,129) - lu(k,803) * b(k,126) + b(k,130) = b(k,130) - lu(k,804) * b(k,126) + b(k,131) = b(k,131) - lu(k,805) * b(k,126) + b(k,132) = b(k,132) - lu(k,806) * b(k,126) + b(k,133) = b(k,133) - lu(k,807) * b(k,126) + b(k,134) = b(k,134) - lu(k,808) * b(k,126) + b(k,135) = b(k,135) - lu(k,809) * b(k,126) + b(k,136) = b(k,136) - lu(k,810) * b(k,126) + b(k,139) = b(k,139) - lu(k,811) * b(k,126) + b(k,128) = b(k,128) - lu(k,821) * b(k,127) + b(k,129) = b(k,129) - lu(k,822) * b(k,127) + b(k,130) = b(k,130) - lu(k,823) * b(k,127) + b(k,131) = b(k,131) - lu(k,824) * b(k,127) + b(k,132) = b(k,132) - lu(k,825) * b(k,127) + b(k,133) = b(k,133) - lu(k,826) * b(k,127) + b(k,134) = b(k,134) - lu(k,827) * b(k,127) + b(k,135) = b(k,135) - lu(k,828) * b(k,127) + b(k,136) = b(k,136) - lu(k,829) * b(k,127) + b(k,137) = b(k,137) - lu(k,830) * b(k,127) + b(k,139) = b(k,139) - lu(k,831) * b(k,127) + b(k,129) = b(k,129) - lu(k,857) * b(k,128) + b(k,130) = b(k,130) - lu(k,858) * b(k,128) + b(k,131) = b(k,131) - lu(k,859) * b(k,128) + b(k,132) = b(k,132) - lu(k,860) * b(k,128) + b(k,133) = b(k,133) - lu(k,861) * b(k,128) + b(k,134) = b(k,134) - lu(k,862) * b(k,128) + b(k,135) = b(k,135) - lu(k,863) * b(k,128) + b(k,136) = b(k,136) - lu(k,864) * b(k,128) + b(k,137) = b(k,137) - lu(k,865) * b(k,128) + b(k,138) = b(k,138) - lu(k,866) * b(k,128) + b(k,139) = b(k,139) - lu(k,867) * b(k,128) + b(k,130) = b(k,130) - lu(k,887) * b(k,129) + b(k,131) = b(k,131) - lu(k,888) * b(k,129) + b(k,132) = b(k,132) - lu(k,889) * b(k,129) + b(k,133) = b(k,133) - lu(k,890) * b(k,129) + b(k,134) = b(k,134) - lu(k,891) * b(k,129) + b(k,135) = b(k,135) - lu(k,892) * b(k,129) + b(k,136) = b(k,136) - lu(k,893) * b(k,129) + b(k,137) = b(k,137) - lu(k,894) * b(k,129) + b(k,138) = b(k,138) - lu(k,895) * b(k,129) + b(k,139) = b(k,139) - lu(k,896) * b(k,129) + b(k,131) = b(k,131) - lu(k,944) * b(k,130) + b(k,132) = b(k,132) - lu(k,945) * b(k,130) + b(k,133) = b(k,133) - lu(k,946) * b(k,130) + b(k,134) = b(k,134) - lu(k,947) * b(k,130) + b(k,135) = b(k,135) - lu(k,948) * b(k,130) + b(k,136) = b(k,136) - lu(k,949) * b(k,130) + b(k,137) = b(k,137) - lu(k,950) * b(k,130) + b(k,138) = b(k,138) - lu(k,951) * b(k,130) + b(k,139) = b(k,139) - lu(k,952) * b(k,130) + b(k,132) = b(k,132) - lu(k,967) * b(k,131) + b(k,133) = b(k,133) - lu(k,968) * b(k,131) + b(k,134) = b(k,134) - lu(k,969) * b(k,131) + b(k,135) = b(k,135) - lu(k,970) * b(k,131) + b(k,136) = b(k,136) - lu(k,971) * b(k,131) + b(k,137) = b(k,137) - lu(k,972) * b(k,131) + b(k,138) = b(k,138) - lu(k,973) * b(k,131) + b(k,139) = b(k,139) - lu(k,974) * b(k,131) + b(k,133) = b(k,133) - lu(k,1012) * b(k,132) + b(k,134) = b(k,134) - lu(k,1013) * b(k,132) + b(k,135) = b(k,135) - lu(k,1014) * b(k,132) + b(k,136) = b(k,136) - lu(k,1015) * b(k,132) + b(k,137) = b(k,137) - lu(k,1016) * b(k,132) + b(k,138) = b(k,138) - lu(k,1017) * b(k,132) + b(k,139) = b(k,139) - lu(k,1018) * b(k,132) + end do + end subroutine lu_slv03 + subroutine lu_slv04( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,134) = b(k,134) - lu(k,1049) * b(k,133) + b(k,135) = b(k,135) - lu(k,1050) * b(k,133) + b(k,136) = b(k,136) - lu(k,1051) * b(k,133) + b(k,137) = b(k,137) - lu(k,1052) * b(k,133) + b(k,138) = b(k,138) - lu(k,1053) * b(k,133) + b(k,139) = b(k,139) - lu(k,1054) * b(k,133) + b(k,135) = b(k,135) - lu(k,1087) * b(k,134) + b(k,136) = b(k,136) - lu(k,1088) * b(k,134) + b(k,137) = b(k,137) - lu(k,1089) * b(k,134) + b(k,138) = b(k,138) - lu(k,1090) * b(k,134) + b(k,139) = b(k,139) - lu(k,1091) * b(k,134) + b(k,136) = b(k,136) - lu(k,1173) * b(k,135) + b(k,137) = b(k,137) - lu(k,1174) * b(k,135) + b(k,138) = b(k,138) - lu(k,1175) * b(k,135) + b(k,139) = b(k,139) - lu(k,1176) * b(k,135) + b(k,137) = b(k,137) - lu(k,1218) * b(k,136) + b(k,138) = b(k,138) - lu(k,1219) * b(k,136) + b(k,139) = b(k,139) - lu(k,1220) * b(k,136) + b(k,138) = b(k,138) - lu(k,1244) * b(k,137) + b(k,139) = b(k,139) - lu(k,1245) * b(k,137) + b(k,139) = b(k,139) - lu(k,1287) * b(k,138) + end do + end subroutine lu_slv04 + subroutine lu_slv05( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(k,139) = b(k,139) * lu(k,1307) + b(k,138) = b(k,138) - lu(k,1306) * b(k,139) + b(k,137) = b(k,137) - lu(k,1305) * b(k,139) + b(k,136) = b(k,136) - lu(k,1304) * b(k,139) + b(k,135) = b(k,135) - lu(k,1303) * b(k,139) + b(k,134) = b(k,134) - lu(k,1302) * b(k,139) + b(k,133) = b(k,133) - lu(k,1301) * b(k,139) + b(k,132) = b(k,132) - lu(k,1300) * b(k,139) + b(k,131) = b(k,131) - lu(k,1299) * b(k,139) + b(k,130) = b(k,130) - lu(k,1298) * b(k,139) + b(k,129) = b(k,129) - lu(k,1297) * b(k,139) + b(k,128) = b(k,128) - lu(k,1296) * b(k,139) + b(k,127) = b(k,127) - lu(k,1295) * b(k,139) + b(k,126) = b(k,126) - lu(k,1294) * b(k,139) + b(k,124) = b(k,124) - lu(k,1293) * b(k,139) + b(k,117) = b(k,117) - lu(k,1292) * b(k,139) + b(k,111) = b(k,111) - lu(k,1291) * b(k,139) + b(k,102) = b(k,102) - lu(k,1290) * b(k,139) + b(k,58) = b(k,58) - lu(k,1289) * b(k,139) + b(k,49) = b(k,49) - lu(k,1288) * b(k,139) + b(k,138) = b(k,138) * lu(k,1286) + b(k,137) = b(k,137) - lu(k,1285) * b(k,138) + b(k,136) = b(k,136) - lu(k,1284) * b(k,138) + b(k,135) = b(k,135) - lu(k,1283) * b(k,138) + b(k,134) = b(k,134) - lu(k,1282) * b(k,138) + b(k,133) = b(k,133) - lu(k,1281) * b(k,138) + b(k,132) = b(k,132) - lu(k,1280) * b(k,138) + b(k,131) = b(k,131) - lu(k,1279) * b(k,138) + b(k,130) = b(k,130) - lu(k,1278) * b(k,138) + b(k,129) = b(k,129) - lu(k,1277) * b(k,138) + b(k,128) = b(k,128) - lu(k,1276) * b(k,138) + b(k,127) = b(k,127) - lu(k,1275) * b(k,138) + b(k,126) = b(k,126) - lu(k,1274) * b(k,138) + b(k,125) = b(k,125) - lu(k,1273) * b(k,138) + b(k,124) = b(k,124) - lu(k,1272) * b(k,138) + b(k,123) = b(k,123) - lu(k,1271) * b(k,138) + b(k,122) = b(k,122) - lu(k,1270) * b(k,138) + b(k,121) = b(k,121) - lu(k,1269) * b(k,138) + b(k,120) = b(k,120) - lu(k,1268) * b(k,138) + b(k,119) = b(k,119) - lu(k,1267) * b(k,138) + b(k,118) = b(k,118) - lu(k,1266) * b(k,138) + b(k,116) = b(k,116) - lu(k,1265) * b(k,138) + b(k,115) = b(k,115) - lu(k,1264) * b(k,138) + b(k,114) = b(k,114) - lu(k,1263) * b(k,138) + b(k,113) = b(k,113) - lu(k,1262) * b(k,138) + b(k,110) = b(k,110) - lu(k,1261) * b(k,138) + b(k,109) = b(k,109) - lu(k,1260) * b(k,138) + b(k,108) = b(k,108) - lu(k,1259) * b(k,138) + b(k,106) = b(k,106) - lu(k,1258) * b(k,138) + b(k,105) = b(k,105) - lu(k,1257) * b(k,138) + b(k,98) = b(k,98) - lu(k,1256) * b(k,138) + b(k,97) = b(k,97) - lu(k,1255) * b(k,138) + b(k,96) = b(k,96) - lu(k,1254) * b(k,138) + b(k,95) = b(k,95) - lu(k,1253) * b(k,138) + b(k,93) = b(k,93) - lu(k,1252) * b(k,138) + b(k,92) = b(k,92) - lu(k,1251) * b(k,138) + b(k,91) = b(k,91) - lu(k,1250) * b(k,138) + b(k,90) = b(k,90) - lu(k,1249) * b(k,138) + b(k,75) = b(k,75) - lu(k,1248) * b(k,138) + b(k,66) = b(k,66) - lu(k,1247) * b(k,138) + b(k,59) = b(k,59) - lu(k,1246) * b(k,138) + b(k,137) = b(k,137) * lu(k,1243) + b(k,136) = b(k,136) - lu(k,1242) * b(k,137) + b(k,135) = b(k,135) - lu(k,1241) * b(k,137) + b(k,134) = b(k,134) - lu(k,1240) * b(k,137) + b(k,133) = b(k,133) - lu(k,1239) * b(k,137) + b(k,132) = b(k,132) - lu(k,1238) * b(k,137) + b(k,131) = b(k,131) - lu(k,1237) * b(k,137) + b(k,130) = b(k,130) - lu(k,1236) * b(k,137) + b(k,129) = b(k,129) - lu(k,1235) * b(k,137) + b(k,128) = b(k,128) - lu(k,1234) * b(k,137) + b(k,127) = b(k,127) - lu(k,1233) * b(k,137) + b(k,126) = b(k,126) - lu(k,1232) * b(k,137) + b(k,125) = b(k,125) - lu(k,1231) * b(k,137) + b(k,124) = b(k,124) - lu(k,1230) * b(k,137) + b(k,123) = b(k,123) - lu(k,1229) * b(k,137) + b(k,117) = b(k,117) - lu(k,1228) * b(k,137) + b(k,104) = b(k,104) - lu(k,1227) * b(k,137) + b(k,102) = b(k,102) - lu(k,1226) * b(k,137) + b(k,99) = b(k,99) - lu(k,1225) * b(k,137) + b(k,65) = b(k,65) - lu(k,1224) * b(k,137) + b(k,56) = b(k,56) - lu(k,1223) * b(k,137) + b(k,50) = b(k,50) - lu(k,1222) * b(k,137) + b(k,34) = b(k,34) - lu(k,1221) * b(k,137) + b(k,136) = b(k,136) * lu(k,1217) + b(k,135) = b(k,135) - lu(k,1216) * b(k,136) + b(k,134) = b(k,134) - lu(k,1215) * b(k,136) + b(k,133) = b(k,133) - lu(k,1214) * b(k,136) + b(k,132) = b(k,132) - lu(k,1213) * b(k,136) + b(k,131) = b(k,131) - lu(k,1212) * b(k,136) + b(k,130) = b(k,130) - lu(k,1211) * b(k,136) + b(k,129) = b(k,129) - lu(k,1210) * b(k,136) + b(k,128) = b(k,128) - lu(k,1209) * b(k,136) + b(k,127) = b(k,127) - lu(k,1208) * b(k,136) + b(k,126) = b(k,126) - lu(k,1207) * b(k,136) + b(k,125) = b(k,125) - lu(k,1206) * b(k,136) + b(k,124) = b(k,124) - lu(k,1205) * b(k,136) + b(k,123) = b(k,123) - lu(k,1204) * b(k,136) + b(k,122) = b(k,122) - lu(k,1203) * b(k,136) + b(k,121) = b(k,121) - lu(k,1202) * b(k,136) + b(k,120) = b(k,120) - lu(k,1201) * b(k,136) + b(k,119) = b(k,119) - lu(k,1200) * b(k,136) + b(k,118) = b(k,118) - lu(k,1199) * b(k,136) + b(k,117) = b(k,117) - lu(k,1198) * b(k,136) + b(k,116) = b(k,116) - lu(k,1197) * b(k,136) + b(k,115) = b(k,115) - lu(k,1196) * b(k,136) + b(k,114) = b(k,114) - lu(k,1195) * b(k,136) + b(k,113) = b(k,113) - lu(k,1194) * b(k,136) + b(k,112) = b(k,112) - lu(k,1193) * b(k,136) + b(k,110) = b(k,110) - lu(k,1192) * b(k,136) + b(k,109) = b(k,109) - lu(k,1191) * b(k,136) + b(k,108) = b(k,108) - lu(k,1190) * b(k,136) + b(k,106) = b(k,106) - lu(k,1189) * b(k,136) + b(k,105) = b(k,105) - lu(k,1188) * b(k,136) + b(k,103) = b(k,103) - lu(k,1187) * b(k,136) + b(k,102) = b(k,102) - lu(k,1186) * b(k,136) + b(k,101) = b(k,101) - lu(k,1185) * b(k,136) + b(k,97) = b(k,97) - lu(k,1184) * b(k,136) + b(k,95) = b(k,95) - lu(k,1183) * b(k,136) + b(k,92) = b(k,92) - lu(k,1182) * b(k,136) + b(k,88) = b(k,88) - lu(k,1181) * b(k,136) + b(k,72) = b(k,72) - lu(k,1180) * b(k,136) + b(k,66) = b(k,66) - lu(k,1179) * b(k,136) + b(k,62) = b(k,62) - lu(k,1178) * b(k,136) + b(k,60) = b(k,60) - lu(k,1177) * b(k,136) + b(k,135) = b(k,135) * lu(k,1172) + b(k,134) = b(k,134) - lu(k,1171) * b(k,135) + b(k,133) = b(k,133) - lu(k,1170) * b(k,135) + b(k,132) = b(k,132) - lu(k,1169) * b(k,135) + b(k,131) = b(k,131) - lu(k,1168) * b(k,135) + b(k,130) = b(k,130) - lu(k,1167) * b(k,135) + b(k,129) = b(k,129) - lu(k,1166) * b(k,135) + b(k,128) = b(k,128) - lu(k,1165) * b(k,135) + b(k,127) = b(k,127) - lu(k,1164) * b(k,135) + b(k,126) = b(k,126) - lu(k,1163) * b(k,135) + b(k,125) = b(k,125) - lu(k,1162) * b(k,135) + b(k,124) = b(k,124) - lu(k,1161) * b(k,135) + b(k,123) = b(k,123) - lu(k,1160) * b(k,135) + b(k,122) = b(k,122) - lu(k,1159) * b(k,135) + b(k,121) = b(k,121) - lu(k,1158) * b(k,135) + b(k,120) = b(k,120) - lu(k,1157) * b(k,135) + b(k,119) = b(k,119) - lu(k,1156) * b(k,135) + b(k,118) = b(k,118) - lu(k,1155) * b(k,135) + b(k,117) = b(k,117) - lu(k,1154) * b(k,135) + b(k,116) = b(k,116) - lu(k,1153) * b(k,135) + b(k,115) = b(k,115) - lu(k,1152) * b(k,135) + b(k,114) = b(k,114) - lu(k,1151) * b(k,135) + b(k,113) = b(k,113) - lu(k,1150) * b(k,135) + b(k,112) = b(k,112) - lu(k,1149) * b(k,135) + b(k,111) = b(k,111) - lu(k,1148) * b(k,135) + b(k,110) = b(k,110) - lu(k,1147) * b(k,135) + b(k,109) = b(k,109) - lu(k,1146) * b(k,135) + b(k,108) = b(k,108) - lu(k,1145) * b(k,135) + b(k,107) = b(k,107) - lu(k,1144) * b(k,135) + b(k,106) = b(k,106) - lu(k,1143) * b(k,135) + b(k,105) = b(k,105) - lu(k,1142) * b(k,135) + b(k,104) = b(k,104) - lu(k,1141) * b(k,135) + b(k,103) = b(k,103) - lu(k,1140) * b(k,135) + b(k,102) = b(k,102) - lu(k,1139) * b(k,135) + b(k,101) = b(k,101) - lu(k,1138) * b(k,135) + b(k,100) = b(k,100) - lu(k,1137) * b(k,135) + b(k,99) = b(k,99) - lu(k,1136) * b(k,135) + b(k,98) = b(k,98) - lu(k,1135) * b(k,135) + b(k,96) = b(k,96) - lu(k,1134) * b(k,135) + b(k,95) = b(k,95) - lu(k,1133) * b(k,135) + b(k,93) = b(k,93) - lu(k,1132) * b(k,135) + b(k,92) = b(k,92) - lu(k,1131) * b(k,135) + b(k,91) = b(k,91) - lu(k,1130) * b(k,135) + b(k,90) = b(k,90) - lu(k,1129) * b(k,135) + b(k,89) = b(k,89) - lu(k,1128) * b(k,135) + b(k,88) = b(k,88) - lu(k,1127) * b(k,135) + b(k,87) = b(k,87) - lu(k,1126) * b(k,135) + b(k,86) = b(k,86) - lu(k,1125) * b(k,135) + b(k,85) = b(k,85) - lu(k,1124) * b(k,135) + b(k,84) = b(k,84) - lu(k,1123) * b(k,135) + b(k,82) = b(k,82) - lu(k,1122) * b(k,135) + b(k,81) = b(k,81) - lu(k,1121) * b(k,135) + b(k,80) = b(k,80) - lu(k,1120) * b(k,135) + b(k,79) = b(k,79) - lu(k,1119) * b(k,135) + b(k,78) = b(k,78) - lu(k,1118) * b(k,135) + b(k,77) = b(k,77) - lu(k,1117) * b(k,135) + b(k,76) = b(k,76) - lu(k,1116) * b(k,135) + b(k,75) = b(k,75) - lu(k,1115) * b(k,135) + b(k,74) = b(k,74) - lu(k,1114) * b(k,135) + b(k,73) = b(k,73) - lu(k,1113) * b(k,135) + b(k,72) = b(k,72) - lu(k,1112) * b(k,135) + b(k,71) = b(k,71) - lu(k,1111) * b(k,135) + b(k,70) = b(k,70) - lu(k,1110) * b(k,135) + b(k,69) = b(k,69) - lu(k,1109) * b(k,135) + b(k,68) = b(k,68) - lu(k,1108) * b(k,135) + b(k,67) = b(k,67) - lu(k,1107) * b(k,135) + b(k,66) = b(k,66) - lu(k,1106) * b(k,135) + b(k,64) = b(k,64) - lu(k,1105) * b(k,135) + b(k,63) = b(k,63) - lu(k,1104) * b(k,135) + b(k,62) = b(k,62) - lu(k,1103) * b(k,135) + b(k,61) = b(k,61) - lu(k,1102) * b(k,135) + b(k,58) = b(k,58) - lu(k,1101) * b(k,135) + b(k,57) = b(k,57) - lu(k,1100) * b(k,135) + b(k,55) = b(k,55) - lu(k,1099) * b(k,135) + b(k,54) = b(k,54) - lu(k,1098) * b(k,135) + b(k,52) = b(k,52) - lu(k,1097) * b(k,135) + b(k,51) = b(k,51) - lu(k,1096) * b(k,135) + b(k,47) = b(k,47) - lu(k,1095) * b(k,135) + b(k,45) = b(k,45) - lu(k,1094) * b(k,135) + b(k,37) = b(k,37) - lu(k,1093) * b(k,135) + b(k,35) = b(k,35) - lu(k,1092) * b(k,135) + end do + end subroutine lu_slv05 + subroutine lu_slv06( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,134) = b(k,134) * lu(k,1086) + b(k,133) = b(k,133) - lu(k,1085) * b(k,134) + b(k,132) = b(k,132) - lu(k,1084) * b(k,134) + b(k,131) = b(k,131) - lu(k,1083) * b(k,134) + b(k,130) = b(k,130) - lu(k,1082) * b(k,134) + b(k,129) = b(k,129) - lu(k,1081) * b(k,134) + b(k,128) = b(k,128) - lu(k,1080) * b(k,134) + b(k,127) = b(k,127) - lu(k,1079) * b(k,134) + b(k,126) = b(k,126) - lu(k,1078) * b(k,134) + b(k,125) = b(k,125) - lu(k,1077) * b(k,134) + b(k,124) = b(k,124) - lu(k,1076) * b(k,134) + b(k,123) = b(k,123) - lu(k,1075) * b(k,134) + b(k,111) = b(k,111) - lu(k,1074) * b(k,134) + b(k,110) = b(k,110) - lu(k,1073) * b(k,134) + b(k,107) = b(k,107) - lu(k,1072) * b(k,134) + b(k,100) = b(k,100) - lu(k,1071) * b(k,134) + b(k,86) = b(k,86) - lu(k,1070) * b(k,134) + b(k,77) = b(k,77) - lu(k,1069) * b(k,134) + b(k,70) = b(k,70) - lu(k,1068) * b(k,134) + b(k,55) = b(k,55) - lu(k,1067) * b(k,134) + b(k,53) = b(k,53) - lu(k,1066) * b(k,134) + b(k,52) = b(k,52) - lu(k,1065) * b(k,134) + b(k,51) = b(k,51) - lu(k,1064) * b(k,134) + b(k,46) = b(k,46) - lu(k,1063) * b(k,134) + b(k,44) = b(k,44) - lu(k,1062) * b(k,134) + b(k,43) = b(k,43) - lu(k,1061) * b(k,134) + b(k,42) = b(k,42) - lu(k,1060) * b(k,134) + b(k,41) = b(k,41) - lu(k,1059) * b(k,134) + b(k,40) = b(k,40) - lu(k,1058) * b(k,134) + b(k,39) = b(k,39) - lu(k,1057) * b(k,134) + b(k,38) = b(k,38) - lu(k,1056) * b(k,134) + b(k,36) = b(k,36) - lu(k,1055) * b(k,134) + b(k,133) = b(k,133) * lu(k,1048) + b(k,132) = b(k,132) - lu(k,1047) * b(k,133) + b(k,131) = b(k,131) - lu(k,1046) * b(k,133) + b(k,130) = b(k,130) - lu(k,1045) * b(k,133) + b(k,129) = b(k,129) - lu(k,1044) * b(k,133) + b(k,128) = b(k,128) - lu(k,1043) * b(k,133) + b(k,127) = b(k,127) - lu(k,1042) * b(k,133) + b(k,126) = b(k,126) - lu(k,1041) * b(k,133) + b(k,125) = b(k,125) - lu(k,1040) * b(k,133) + b(k,124) = b(k,124) - lu(k,1039) * b(k,133) + b(k,123) = b(k,123) - lu(k,1038) * b(k,133) + b(k,122) = b(k,122) - lu(k,1037) * b(k,133) + b(k,121) = b(k,121) - lu(k,1036) * b(k,133) + b(k,120) = b(k,120) - lu(k,1035) * b(k,133) + b(k,117) = b(k,117) - lu(k,1034) * b(k,133) + b(k,116) = b(k,116) - lu(k,1033) * b(k,133) + b(k,110) = b(k,110) - lu(k,1032) * b(k,133) + b(k,109) = b(k,109) - lu(k,1031) * b(k,133) + b(k,104) = b(k,104) - lu(k,1030) * b(k,133) + b(k,102) = b(k,102) - lu(k,1029) * b(k,133) + b(k,101) = b(k,101) - lu(k,1028) * b(k,133) + b(k,94) = b(k,94) - lu(k,1027) * b(k,133) + b(k,90) = b(k,90) - lu(k,1026) * b(k,133) + b(k,85) = b(k,85) - lu(k,1025) * b(k,133) + b(k,83) = b(k,83) - lu(k,1024) * b(k,133) + b(k,81) = b(k,81) - lu(k,1023) * b(k,133) + b(k,75) = b(k,75) - lu(k,1022) * b(k,133) + b(k,69) = b(k,69) - lu(k,1021) * b(k,133) + b(k,60) = b(k,60) - lu(k,1020) * b(k,133) + b(k,53) = b(k,53) - lu(k,1019) * b(k,133) + b(k,132) = b(k,132) * lu(k,1011) + b(k,131) = b(k,131) - lu(k,1010) * b(k,132) + b(k,130) = b(k,130) - lu(k,1009) * b(k,132) + b(k,129) = b(k,129) - lu(k,1008) * b(k,132) + b(k,128) = b(k,128) - lu(k,1007) * b(k,132) + b(k,127) = b(k,127) - lu(k,1006) * b(k,132) + b(k,126) = b(k,126) - lu(k,1005) * b(k,132) + b(k,125) = b(k,125) - lu(k,1004) * b(k,132) + b(k,124) = b(k,124) - lu(k,1003) * b(k,132) + b(k,123) = b(k,123) - lu(k,1002) * b(k,132) + b(k,122) = b(k,122) - lu(k,1001) * b(k,132) + b(k,121) = b(k,121) - lu(k,1000) * b(k,132) + b(k,120) = b(k,120) - lu(k,999) * b(k,132) + b(k,119) = b(k,119) - lu(k,998) * b(k,132) + b(k,118) = b(k,118) - lu(k,997) * b(k,132) + b(k,117) = b(k,117) - lu(k,996) * b(k,132) + b(k,116) = b(k,116) - lu(k,995) * b(k,132) + b(k,115) = b(k,115) - lu(k,994) * b(k,132) + b(k,114) = b(k,114) - lu(k,993) * b(k,132) + b(k,113) = b(k,113) - lu(k,992) * b(k,132) + b(k,112) = b(k,112) - lu(k,991) * b(k,132) + b(k,111) = b(k,111) - lu(k,990) * b(k,132) + b(k,110) = b(k,110) - lu(k,989) * b(k,132) + b(k,109) = b(k,109) - lu(k,988) * b(k,132) + b(k,108) = b(k,108) - lu(k,987) * b(k,132) + b(k,107) = b(k,107) - lu(k,986) * b(k,132) + b(k,106) = b(k,106) - lu(k,985) * b(k,132) + b(k,105) = b(k,105) - lu(k,984) * b(k,132) + b(k,103) = b(k,103) - lu(k,983) * b(k,132) + b(k,102) = b(k,102) - lu(k,982) * b(k,132) + b(k,95) = b(k,95) - lu(k,981) * b(k,132) + b(k,91) = b(k,91) - lu(k,980) * b(k,132) + b(k,90) = b(k,90) - lu(k,979) * b(k,132) + b(k,89) = b(k,89) - lu(k,978) * b(k,132) + b(k,88) = b(k,88) - lu(k,977) * b(k,132) + b(k,78) = b(k,78) - lu(k,976) * b(k,132) + b(k,76) = b(k,76) - lu(k,975) * b(k,132) + b(k,131) = b(k,131) * lu(k,966) + b(k,130) = b(k,130) - lu(k,965) * b(k,131) + b(k,129) = b(k,129) - lu(k,964) * b(k,131) + b(k,128) = b(k,128) - lu(k,963) * b(k,131) + b(k,127) = b(k,127) - lu(k,962) * b(k,131) + b(k,126) = b(k,126) - lu(k,961) * b(k,131) + b(k,124) = b(k,124) - lu(k,960) * b(k,131) + b(k,117) = b(k,117) - lu(k,959) * b(k,131) + b(k,102) = b(k,102) - lu(k,958) * b(k,131) + b(k,101) = b(k,101) - lu(k,957) * b(k,131) + b(k,94) = b(k,94) - lu(k,956) * b(k,131) + b(k,83) = b(k,83) - lu(k,955) * b(k,131) + b(k,65) = b(k,65) - lu(k,954) * b(k,131) + b(k,56) = b(k,56) - lu(k,953) * b(k,131) + b(k,130) = b(k,130) * lu(k,943) + b(k,129) = b(k,129) - lu(k,942) * b(k,130) + b(k,128) = b(k,128) - lu(k,941) * b(k,130) + b(k,127) = b(k,127) - lu(k,940) * b(k,130) + b(k,126) = b(k,126) - lu(k,939) * b(k,130) + b(k,125) = b(k,125) - lu(k,938) * b(k,130) + b(k,124) = b(k,124) - lu(k,937) * b(k,130) + b(k,123) = b(k,123) - lu(k,936) * b(k,130) + b(k,122) = b(k,122) - lu(k,935) * b(k,130) + b(k,121) = b(k,121) - lu(k,934) * b(k,130) + b(k,120) = b(k,120) - lu(k,933) * b(k,130) + b(k,119) = b(k,119) - lu(k,932) * b(k,130) + b(k,118) = b(k,118) - lu(k,931) * b(k,130) + b(k,116) = b(k,116) - lu(k,930) * b(k,130) + b(k,115) = b(k,115) - lu(k,929) * b(k,130) + b(k,114) = b(k,114) - lu(k,928) * b(k,130) + b(k,113) = b(k,113) - lu(k,927) * b(k,130) + b(k,111) = b(k,111) - lu(k,926) * b(k,130) + b(k,110) = b(k,110) - lu(k,925) * b(k,130) + b(k,109) = b(k,109) - lu(k,924) * b(k,130) + b(k,108) = b(k,108) - lu(k,923) * b(k,130) + b(k,106) = b(k,106) - lu(k,922) * b(k,130) + b(k,105) = b(k,105) - lu(k,921) * b(k,130) + b(k,100) = b(k,100) - lu(k,920) * b(k,130) + b(k,99) = b(k,99) - lu(k,919) * b(k,130) + b(k,98) = b(k,98) - lu(k,918) * b(k,130) + b(k,97) = b(k,97) - lu(k,917) * b(k,130) + b(k,96) = b(k,96) - lu(k,916) * b(k,130) + b(k,95) = b(k,95) - lu(k,915) * b(k,130) + b(k,94) = b(k,94) - lu(k,914) * b(k,130) + b(k,93) = b(k,93) - lu(k,913) * b(k,130) + b(k,91) = b(k,91) - lu(k,912) * b(k,130) + b(k,90) = b(k,90) - lu(k,911) * b(k,130) + b(k,89) = b(k,89) - lu(k,910) * b(k,130) + b(k,87) = b(k,87) - lu(k,909) * b(k,130) + b(k,84) = b(k,84) - lu(k,908) * b(k,130) + b(k,82) = b(k,82) - lu(k,907) * b(k,130) + b(k,79) = b(k,79) - lu(k,906) * b(k,130) + b(k,74) = b(k,74) - lu(k,905) * b(k,130) + b(k,73) = b(k,73) - lu(k,904) * b(k,130) + b(k,71) = b(k,71) - lu(k,903) * b(k,130) + b(k,69) = b(k,69) - lu(k,902) * b(k,130) + b(k,64) = b(k,64) - lu(k,901) * b(k,130) + b(k,63) = b(k,63) - lu(k,900) * b(k,130) + b(k,59) = b(k,59) - lu(k,899) * b(k,130) + b(k,54) = b(k,54) - lu(k,898) * b(k,130) + b(k,48) = b(k,48) - lu(k,897) * b(k,130) + b(k,129) = b(k,129) * lu(k,886) + b(k,128) = b(k,128) - lu(k,885) * b(k,129) + b(k,127) = b(k,127) - lu(k,884) * b(k,129) + b(k,126) = b(k,126) - lu(k,883) * b(k,129) + b(k,125) = b(k,125) - lu(k,882) * b(k,129) + b(k,124) = b(k,124) - lu(k,881) * b(k,129) + b(k,117) = b(k,117) - lu(k,880) * b(k,129) + b(k,111) = b(k,111) - lu(k,879) * b(k,129) + b(k,110) = b(k,110) - lu(k,878) * b(k,129) + b(k,104) = b(k,104) - lu(k,877) * b(k,129) + b(k,102) = b(k,102) - lu(k,876) * b(k,129) + b(k,101) = b(k,101) - lu(k,875) * b(k,129) + b(k,100) = b(k,100) - lu(k,874) * b(k,129) + b(k,99) = b(k,99) - lu(k,873) * b(k,129) + b(k,94) = b(k,94) - lu(k,872) * b(k,129) + b(k,84) = b(k,84) - lu(k,871) * b(k,129) + b(k,83) = b(k,83) - lu(k,870) * b(k,129) + b(k,78) = b(k,78) - lu(k,869) * b(k,129) + b(k,67) = b(k,67) - lu(k,868) * b(k,129) + b(k,128) = b(k,128) * lu(k,856) + b(k,127) = b(k,127) - lu(k,855) * b(k,128) + b(k,126) = b(k,126) - lu(k,854) * b(k,128) + b(k,125) = b(k,125) - lu(k,853) * b(k,128) + b(k,124) = b(k,124) - lu(k,852) * b(k,128) + b(k,123) = b(k,123) - lu(k,851) * b(k,128) + b(k,122) = b(k,122) - lu(k,850) * b(k,128) + b(k,121) = b(k,121) - lu(k,849) * b(k,128) + b(k,113) = b(k,113) - lu(k,848) * b(k,128) + b(k,111) = b(k,111) - lu(k,847) * b(k,128) + b(k,110) = b(k,110) - lu(k,846) * b(k,128) + b(k,107) = b(k,107) - lu(k,845) * b(k,128) + b(k,105) = b(k,105) - lu(k,844) * b(k,128) + b(k,104) = b(k,104) - lu(k,843) * b(k,128) + b(k,99) = b(k,99) - lu(k,842) * b(k,128) + b(k,96) = b(k,96) - lu(k,841) * b(k,128) + b(k,91) = b(k,91) - lu(k,840) * b(k,128) + b(k,86) = b(k,86) - lu(k,839) * b(k,128) + b(k,84) = b(k,84) - lu(k,838) * b(k,128) + b(k,77) = b(k,77) - lu(k,837) * b(k,128) + b(k,76) = b(k,76) - lu(k,836) * b(k,128) + b(k,70) = b(k,70) - lu(k,835) * b(k,128) + b(k,68) = b(k,68) - lu(k,834) * b(k,128) + b(k,61) = b(k,61) - lu(k,833) * b(k,128) + b(k,50) = b(k,50) - lu(k,832) * b(k,128) + end do + end subroutine lu_slv06 + subroutine lu_slv07( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,127) = b(k,127) * lu(k,820) + b(k,126) = b(k,126) - lu(k,819) * b(k,127) + b(k,124) = b(k,124) - lu(k,818) * b(k,127) + b(k,104) = b(k,104) - lu(k,817) * b(k,127) + b(k,101) = b(k,101) - lu(k,816) * b(k,127) + b(k,99) = b(k,99) - lu(k,815) * b(k,127) + b(k,94) = b(k,94) - lu(k,814) * b(k,127) + b(k,56) = b(k,56) - lu(k,813) * b(k,127) + b(k,50) = b(k,50) - lu(k,812) * b(k,127) + b(k,126) = b(k,126) * lu(k,800) + b(k,125) = b(k,125) - lu(k,799) * b(k,126) + b(k,124) = b(k,124) - lu(k,798) * b(k,126) + b(k,110) = b(k,110) - lu(k,797) * b(k,126) + b(k,100) = b(k,100) - lu(k,796) * b(k,126) + b(k,125) = b(k,125) * lu(k,783) + b(k,124) = b(k,124) - lu(k,782) * b(k,125) + b(k,111) = b(k,111) - lu(k,781) * b(k,125) + b(k,110) = b(k,110) - lu(k,780) * b(k,125) + b(k,101) = b(k,101) - lu(k,779) * b(k,125) + b(k,100) = b(k,100) - lu(k,778) * b(k,125) + b(k,124) = b(k,124) * lu(k,769) + b(k,111) = b(k,111) - lu(k,768) * b(k,124) + b(k,123) = b(k,123) * lu(k,753) + b(k,122) = b(k,122) - lu(k,752) * b(k,123) + b(k,121) = b(k,121) - lu(k,751) * b(k,123) + b(k,120) = b(k,120) - lu(k,750) * b(k,123) + b(k,119) = b(k,119) - lu(k,749) * b(k,123) + b(k,118) = b(k,118) - lu(k,748) * b(k,123) + b(k,116) = b(k,116) - lu(k,747) * b(k,123) + b(k,115) = b(k,115) - lu(k,746) * b(k,123) + b(k,114) = b(k,114) - lu(k,745) * b(k,123) + b(k,113) = b(k,113) - lu(k,744) * b(k,123) + b(k,110) = b(k,110) - lu(k,743) * b(k,123) + b(k,109) = b(k,109) - lu(k,742) * b(k,123) + b(k,108) = b(k,108) - lu(k,741) * b(k,123) + b(k,105) = b(k,105) - lu(k,740) * b(k,123) + b(k,98) = b(k,98) - lu(k,739) * b(k,123) + b(k,96) = b(k,96) - lu(k,738) * b(k,123) + b(k,95) = b(k,95) - lu(k,737) * b(k,123) + b(k,92) = b(k,92) - lu(k,736) * b(k,123) + b(k,90) = b(k,90) - lu(k,735) * b(k,123) + b(k,89) = b(k,89) - lu(k,734) * b(k,123) + b(k,80) = b(k,80) - lu(k,733) * b(k,123) + b(k,73) = b(k,73) - lu(k,732) * b(k,123) + b(k,66) = b(k,66) - lu(k,731) * b(k,123) + b(k,57) = b(k,57) - lu(k,730) * b(k,123) + b(k,122) = b(k,122) * lu(k,715) + b(k,121) = b(k,121) - lu(k,714) * b(k,122) + b(k,120) = b(k,120) - lu(k,713) * b(k,122) + b(k,119) = b(k,119) - lu(k,712) * b(k,122) + b(k,116) = b(k,116) - lu(k,711) * b(k,122) + b(k,113) = b(k,113) - lu(k,710) * b(k,122) + b(k,112) = b(k,112) - lu(k,709) * b(k,122) + b(k,110) = b(k,110) - lu(k,708) * b(k,122) + b(k,90) = b(k,90) - lu(k,707) * b(k,122) + b(k,121) = b(k,121) * lu(k,695) + b(k,120) = b(k,120) - lu(k,694) * b(k,121) + b(k,119) = b(k,119) - lu(k,693) * b(k,121) + b(k,118) = b(k,118) - lu(k,692) * b(k,121) + b(k,116) = b(k,116) - lu(k,691) * b(k,121) + b(k,115) = b(k,115) - lu(k,690) * b(k,121) + b(k,114) = b(k,114) - lu(k,689) * b(k,121) + b(k,110) = b(k,110) - lu(k,688) * b(k,121) + b(k,109) = b(k,109) - lu(k,687) * b(k,121) + b(k,105) = b(k,105) - lu(k,686) * b(k,121) + b(k,92) = b(k,92) - lu(k,685) * b(k,121) + b(k,90) = b(k,90) - lu(k,684) * b(k,121) + b(k,89) = b(k,89) - lu(k,683) * b(k,121) + b(k,87) = b(k,87) - lu(k,682) * b(k,121) + b(k,81) = b(k,81) - lu(k,681) * b(k,121) + b(k,66) = b(k,66) - lu(k,680) * b(k,121) + b(k,120) = b(k,120) * lu(k,668) + b(k,116) = b(k,116) - lu(k,667) * b(k,120) + b(k,110) = b(k,110) - lu(k,666) * b(k,120) + b(k,109) = b(k,109) - lu(k,665) * b(k,120) + b(k,90) = b(k,90) - lu(k,664) * b(k,120) + b(k,89) = b(k,89) - lu(k,663) * b(k,120) + b(k,87) = b(k,87) - lu(k,662) * b(k,120) + b(k,85) = b(k,85) - lu(k,661) * b(k,120) + b(k,119) = b(k,119) * lu(k,649) + b(k,116) = b(k,116) - lu(k,648) * b(k,119) + b(k,115) = b(k,115) - lu(k,647) * b(k,119) + b(k,110) = b(k,110) - lu(k,646) * b(k,119) + b(k,109) = b(k,109) - lu(k,645) * b(k,119) + b(k,106) = b(k,106) - lu(k,644) * b(k,119) + b(k,105) = b(k,105) - lu(k,643) * b(k,119) + b(k,80) = b(k,80) - lu(k,642) * b(k,119) + b(k,63) = b(k,63) - lu(k,641) * b(k,119) + b(k,118) = b(k,118) * lu(k,626) + b(k,116) = b(k,116) - lu(k,625) * b(k,118) + b(k,115) = b(k,115) - lu(k,624) * b(k,118) + b(k,114) = b(k,114) - lu(k,623) * b(k,118) + b(k,110) = b(k,110) - lu(k,622) * b(k,118) + b(k,109) = b(k,109) - lu(k,621) * b(k,118) + b(k,106) = b(k,106) - lu(k,620) * b(k,118) + b(k,105) = b(k,105) - lu(k,619) * b(k,118) + b(k,92) = b(k,92) - lu(k,618) * b(k,118) + b(k,80) = b(k,80) - lu(k,617) * b(k,118) + b(k,79) = b(k,79) - lu(k,616) * b(k,118) + b(k,66) = b(k,66) - lu(k,615) * b(k,118) + b(k,117) = b(k,117) * lu(k,602) + b(k,102) = b(k,102) - lu(k,601) * b(k,117) + b(k,78) = b(k,78) - lu(k,600) * b(k,117) + b(k,65) = b(k,65) - lu(k,599) * b(k,117) + b(k,116) = b(k,116) * lu(k,591) + b(k,110) = b(k,110) - lu(k,590) * b(k,116) + b(k,101) = b(k,101) - lu(k,589) * b(k,116) + b(k,115) = b(k,115) * lu(k,578) + b(k,110) = b(k,110) - lu(k,577) * b(k,115) + b(k,109) = b(k,109) - lu(k,576) * b(k,115) + b(k,105) = b(k,105) - lu(k,575) * b(k,115) + b(k,92) = b(k,92) - lu(k,574) * b(k,115) + b(k,90) = b(k,90) - lu(k,573) * b(k,115) + b(k,80) = b(k,80) - lu(k,572) * b(k,115) + b(k,54) = b(k,54) - lu(k,571) * b(k,115) + b(k,114) = b(k,114) * lu(k,560) + b(k,110) = b(k,110) - lu(k,559) * b(k,114) + b(k,113) = b(k,113) * lu(k,550) + b(k,110) = b(k,110) - lu(k,549) * b(k,113) + b(k,101) = b(k,101) - lu(k,548) * b(k,113) + b(k,112) = b(k,112) * lu(k,530) + b(k,111) = b(k,111) - lu(k,529) * b(k,112) + b(k,110) = b(k,110) - lu(k,528) * b(k,112) + b(k,109) = b(k,109) - lu(k,527) * b(k,112) + b(k,107) = b(k,107) - lu(k,526) * b(k,112) + b(k,93) = b(k,93) - lu(k,525) * b(k,112) + b(k,90) = b(k,90) - lu(k,524) * b(k,112) + b(k,89) = b(k,89) - lu(k,523) * b(k,112) + b(k,72) = b(k,72) - lu(k,522) * b(k,112) + b(k,111) = b(k,111) * lu(k,514) + b(k,110) = b(k,110) * lu(k,510) + b(k,90) = b(k,90) - lu(k,509) * b(k,110) + b(k,109) = b(k,109) * lu(k,503) + b(k,108) = b(k,108) * lu(k,492) + b(k,80) = b(k,80) - lu(k,491) * b(k,108) + b(k,74) = b(k,74) - lu(k,490) * b(k,108) + b(k,107) = b(k,107) * lu(k,477) + b(k,90) = b(k,90) - lu(k,476) * b(k,107) + b(k,106) = b(k,106) * lu(k,467) + b(k,101) = b(k,101) - lu(k,466) * b(k,106) + b(k,66) = b(k,66) - lu(k,465) * b(k,106) + b(k,105) = b(k,105) * lu(k,459) + b(k,92) = b(k,92) - lu(k,458) * b(k,105) + b(k,90) = b(k,90) - lu(k,457) * b(k,105) + b(k,104) = b(k,104) * lu(k,448) + b(k,101) = b(k,101) - lu(k,447) * b(k,104) + b(k,99) = b(k,99) - lu(k,446) * b(k,104) + b(k,50) = b(k,50) - lu(k,445) * b(k,104) + b(k,103) = b(k,103) * lu(k,429) + b(k,97) = b(k,97) - lu(k,428) * b(k,103) + b(k,102) = b(k,102) * lu(k,422) + b(k,58) = b(k,58) - lu(k,421) * b(k,102) + b(k,101) = b(k,101) * lu(k,416) + b(k,100) = b(k,100) * lu(k,408) + b(k,99) = b(k,99) * lu(k,401) + b(k,50) = b(k,50) - lu(k,400) * b(k,99) + b(k,98) = b(k,98) * lu(k,389) + b(k,95) = b(k,95) - lu(k,388) * b(k,98) + b(k,71) = b(k,71) - lu(k,387) * b(k,98) + b(k,97) = b(k,97) * lu(k,377) + b(k,96) = b(k,96) * lu(k,369) + b(k,80) = b(k,80) - lu(k,368) * b(k,96) + b(k,64) = b(k,64) - lu(k,367) * b(k,96) + b(k,57) = b(k,57) - lu(k,366) * b(k,96) + b(k,95) = b(k,95) * lu(k,360) + b(k,94) = b(k,94) * lu(k,352) + b(k,56) = b(k,56) - lu(k,351) * b(k,94) + b(k,93) = b(k,93) * lu(k,342) + b(k,82) = b(k,82) - lu(k,341) * b(k,93) + b(k,92) = b(k,92) * lu(k,336) + b(k,90) = b(k,90) - lu(k,335) * b(k,92) + b(k,91) = b(k,91) * lu(k,328) + b(k,59) = b(k,59) - lu(k,327) * b(k,91) + b(k,48) = b(k,48) - lu(k,326) * b(k,91) + b(k,90) = b(k,90) * lu(k,323) + b(k,89) = b(k,89) * lu(k,318) + b(k,88) = b(k,88) * lu(k,308) + b(k,87) = b(k,87) * lu(k,301) + b(k,86) = b(k,86) * lu(k,292) + b(k,85) = b(k,85) * lu(k,283) + b(k,84) = b(k,84) * lu(k,276) + b(k,83) = b(k,83) * lu(k,268) + b(k,82) = b(k,82) * lu(k,260) + b(k,81) = b(k,81) * lu(k,252) + b(k,80) = b(k,80) * lu(k,248) + b(k,79) = b(k,79) * lu(k,240) + b(k,78) = b(k,78) * lu(k,234) + b(k,77) = b(k,77) * lu(k,227) + b(k,76) = b(k,76) * lu(k,220) + b(k,75) = b(k,75) * lu(k,213) + b(k,53) = b(k,53) - lu(k,212) * b(k,75) + b(k,74) = b(k,74) * lu(k,206) + b(k,73) = b(k,73) * lu(k,200) + b(k,72) = b(k,72) * lu(k,194) + b(k,71) = b(k,71) * lu(k,188) + b(k,70) = b(k,70) * lu(k,182) + b(k,69) = b(k,69) * lu(k,176) + b(k,68) = b(k,68) * lu(k,168) + b(k,67) = b(k,67) * lu(k,160) + b(k,66) = b(k,66) * lu(k,157) + b(k,65) = b(k,65) * lu(k,152) + end do + end subroutine lu_slv07 + subroutine lu_slv08( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,64) = b(k,64) * lu(k,147) + b(k,63) = b(k,63) * lu(k,142) + b(k,62) = b(k,62) * lu(k,136) + b(k,61) = b(k,61) * lu(k,130) + b(k,60) = b(k,60) * lu(k,124) + b(k,59) = b(k,59) * lu(k,120) + b(k,58) = b(k,58) * lu(k,116) + b(k,49) = b(k,49) - lu(k,115) * b(k,58) + b(k,57) = b(k,57) * lu(k,111) + b(k,56) = b(k,56) * lu(k,108) + b(k,55) = b(k,55) * lu(k,103) + b(k,54) = b(k,54) * lu(k,100) + b(k,53) = b(k,53) * lu(k,97) + b(k,52) = b(k,52) * lu(k,93) + b(k,51) = b(k,51) * lu(k,89) + b(k,50) = b(k,50) * lu(k,87) + b(k,49) = b(k,49) * lu(k,84) + b(k,48) = b(k,48) * lu(k,81) + b(k,47) = b(k,47) * lu(k,77) + b(k,46) = b(k,46) * lu(k,73) + b(k,45) = b(k,45) * lu(k,69) + b(k,44) = b(k,44) * lu(k,66) + b(k,43) = b(k,43) * lu(k,63) + b(k,42) = b(k,42) * lu(k,60) + b(k,41) = b(k,41) * lu(k,57) + b(k,40) = b(k,40) * lu(k,54) + b(k,39) = b(k,39) * lu(k,51) + b(k,38) = b(k,38) * lu(k,48) + b(k,37) = b(k,37) * lu(k,45) + b(k,36) = b(k,36) * lu(k,42) + b(k,35) = b(k,35) * lu(k,39) + b(k,34) = b(k,34) * lu(k,36) + b(k,33) = b(k,33) * lu(k,35) + b(k,32) = b(k,32) * lu(k,34) + b(k,31) = b(k,31) * lu(k,32) + b(k,30) = b(k,30) * lu(k,31) + b(k,29) = b(k,29) * lu(k,30) + b(k,28) = b(k,28) * lu(k,29) + b(k,27) = b(k,27) * lu(k,28) + b(k,26) = b(k,26) * lu(k,27) + b(k,25) = b(k,25) * lu(k,26) + b(k,24) = b(k,24) * lu(k,25) + b(k,23) = b(k,23) * lu(k,24) + b(k,22) = b(k,22) * lu(k,23) + b(k,21) = b(k,21) * lu(k,22) + b(k,20) = b(k,20) * lu(k,21) + b(k,19) = b(k,19) * lu(k,20) + b(k,18) = b(k,18) * lu(k,19) + b(k,17) = b(k,17) * lu(k,18) + b(k,16) = b(k,16) * lu(k,17) + b(k,15) = b(k,15) * lu(k,16) + b(k,14) = b(k,14) * lu(k,15) + b(k,13) = b(k,13) * lu(k,14) + b(k,12) = b(k,12) * lu(k,13) + b(k,11) = b(k,11) * lu(k,12) + b(k,10) = b(k,10) * lu(k,11) + b(k,9) = b(k,9) * lu(k,9) + b(k,8) = b(k,8) * lu(k,8) + b(k,7) = b(k,7) * lu(k,7) + b(k,6) = b(k,6) * lu(k,6) + b(k,5) = b(k,5) * lu(k,5) + b(k,4) = b(k,4) * lu(k,4) + b(k,3) = b(k,3) * lu(k,3) + b(k,2) = b(k,2) * lu(k,2) + b(k,1) = b(k,1) * lu(k,1) + end do + end subroutine lu_slv08 + subroutine lu_slv( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) + call lu_slv01( avec_len, lu, b ) + call lu_slv02( avec_len, lu, b ) + call lu_slv03( avec_len, lu, b ) + call lu_slv04( avec_len, lu, b ) + call lu_slv05( avec_len, lu, b ) + call lu_slv06( avec_len, lu, b ) + call lu_slv07( avec_len, lu, b ) + call lu_slv08( avec_len, lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_nln_matrix.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_nln_matrix.F90 new file mode 100644 index 0000000000..388e9b1dad --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_nln_matrix.F90 @@ -0,0 +1,2217 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only: veclen + private + public :: nlnmat + contains + subroutine nlnmat01( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,39) = -(rxt(k,293)*y(k,137)) + mat(k,1092) = -rxt(k,293)*y(k,3) + mat(k,800) = -(rxt(k,173)*y(k,25) + rxt(k,174)*y(k,132) + rxt(k,175)*y(k,98)) + mat(k,784) = -rxt(k,173)*y(k,4) + mat(k,939) = -rxt(k,174)*y(k,4) + mat(k,1005) = -rxt(k,175)*y(k,4) + mat(k,961) = 4.000_r8*rxt(k,176)*y(k,6) + (rxt(k,177)+rxt(k,178))*y(k,41) & + + rxt(k,181)*y(k,88) + rxt(k,184)*y(k,97) + rxt(k,325)*y(k,110) & + + rxt(k,185)*y(k,137) + mat(k,74) = rxt(k,163)*y(k,136) + mat(k,52) = rxt(k,189)*y(k,136) + mat(k,228) = 2.000_r8*rxt(k,194)*y(k,38) + 2.000_r8*rxt(k,206)*y(k,136) & + + 2.000_r8*rxt(k,195)*y(k,137) + mat(k,294) = rxt(k,196)*y(k,38) + rxt(k,207)*y(k,136) + rxt(k,197)*y(k,137) + mat(k,183) = 3.000_r8*rxt(k,201)*y(k,38) + 3.000_r8*rxt(k,190)*y(k,136) & + + 3.000_r8*rxt(k,202)*y(k,137) + mat(k,854) = 2.000_r8*rxt(k,194)*y(k,24) + rxt(k,196)*y(k,26) & + + 3.000_r8*rxt(k,201)*y(k,37) + mat(k,1232) = (rxt(k,177)+rxt(k,178))*y(k,6) + mat(k,43) = 2.000_r8*rxt(k,191)*y(k,136) + mat(k,410) = rxt(k,186)*y(k,97) + rxt(k,192)*y(k,136) + rxt(k,187)*y(k,137) + mat(k,1274) = rxt(k,181)*y(k,6) + mat(k,883) = rxt(k,184)*y(k,6) + rxt(k,186)*y(k,59) + mat(k,604) = rxt(k,325)*y(k,6) + mat(k,1078) = rxt(k,163)*y(k,17) + rxt(k,189)*y(k,18) + 2.000_r8*rxt(k,206) & + *y(k,24) + rxt(k,207)*y(k,26) + 3.000_r8*rxt(k,190)*y(k,37) & + + 2.000_r8*rxt(k,191)*y(k,56) + rxt(k,192)*y(k,59) + mat(k,1163) = rxt(k,185)*y(k,6) + 2.000_r8*rxt(k,195)*y(k,24) + rxt(k,197) & + *y(k,26) + 3.000_r8*rxt(k,202)*y(k,37) + rxt(k,187)*y(k,59) + mat(k,953) = rxt(k,179)*y(k,41) + mat(k,1223) = rxt(k,179)*y(k,6) + mat(k,813) = (rxt(k,351)+rxt(k,356))*y(k,67) + mat(k,351) = (rxt(k,351)+rxt(k,356))*y(k,63) + mat(k,966) = -(4._r8*rxt(k,176)*y(k,6) + (rxt(k,177) + rxt(k,178) + rxt(k,179) & + ) * y(k,41) + rxt(k,180)*y(k,132) + rxt(k,181)*y(k,88) + rxt(k,182) & + *y(k,89) + rxt(k,184)*y(k,97) + rxt(k,185)*y(k,137) + rxt(k,325) & + *y(k,110)) + mat(k,1237) = -(rxt(k,177) + rxt(k,178) + rxt(k,179)) * y(k,6) + mat(k,944) = -rxt(k,180)*y(k,6) + mat(k,1279) = -rxt(k,181)*y(k,6) + mat(k,1046) = -rxt(k,182)*y(k,6) + mat(k,888) = -rxt(k,184)*y(k,6) + mat(k,1168) = -rxt(k,185)*y(k,6) + mat(k,608) = -rxt(k,325)*y(k,6) + mat(k,805) = rxt(k,175)*y(k,98) + mat(k,273) = rxt(k,183)*y(k,97) + mat(k,412) = rxt(k,193)*y(k,136) + mat(k,357) = rxt(k,188)*y(k,97) + mat(k,888) = mat(k,888) + rxt(k,183)*y(k,7) + rxt(k,188)*y(k,67) + mat(k,1010) = rxt(k,175)*y(k,4) + mat(k,1083) = rxt(k,193)*y(k,59) + mat(k,268) = -(rxt(k,183)*y(k,97)) + mat(k,870) = -rxt(k,183)*y(k,7) + mat(k,955) = rxt(k,182)*y(k,89) + mat(k,1024) = rxt(k,182)*y(k,6) + mat(k,220) = -(rxt(k,225)*y(k,38) + rxt(k,226)*y(k,98) + rxt(k,250)*y(k,137)) + mat(k,836) = -rxt(k,225)*y(k,9) + mat(k,975) = -rxt(k,226)*y(k,9) + mat(k,1116) = -rxt(k,250)*y(k,9) + mat(k,111) = -(rxt(k,231)*y(k,137)) + mat(k,1100) = -rxt(k,231)*y(k,10) + mat(k,366) = .800_r8*rxt(k,227)*y(k,126) + .200_r8*rxt(k,228)*y(k,129) + mat(k,730) = .200_r8*rxt(k,228)*y(k,126) + mat(k,147) = -(rxt(k,232)*y(k,137)) + mat(k,1105) = -rxt(k,232)*y(k,11) + mat(k,367) = rxt(k,229)*y(k,132) + mat(k,901) = rxt(k,229)*y(k,126) + mat(k,130) = -(rxt(k,233)*y(k,38) + rxt(k,234)*y(k,137)) + mat(k,833) = -rxt(k,233)*y(k,12) + mat(k,1102) = -rxt(k,234)*y(k,12) + mat(k,530) = -(rxt(k,253)*y(k,90) + rxt(k,254)*y(k,98) + rxt(k,271)*y(k,137)) + mat(k,1193) = -rxt(k,253)*y(k,13) + mat(k,991) = -rxt(k,254)*y(k,13) + mat(k,1149) = -rxt(k,271)*y(k,13) + mat(k,432) = .130_r8*rxt(k,304)*y(k,98) + mat(k,991) = mat(k,991) + .130_r8*rxt(k,304)*y(k,71) + mat(k,188) = -(rxt(k,258)*y(k,137)) + mat(k,1111) = -rxt(k,258)*y(k,14) + mat(k,387) = rxt(k,256)*y(k,132) + mat(k,903) = rxt(k,256)*y(k,127) + mat(k,69) = -(rxt(k,259)*y(k,137)) + mat(k,1094) = -rxt(k,259)*y(k,15) + mat(k,48) = -(rxt(k,162)*y(k,136)) + mat(k,1056) = -rxt(k,162)*y(k,16) + mat(k,73) = -(rxt(k,163)*y(k,136)) + mat(k,1063) = -rxt(k,163)*y(k,17) + mat(k,51) = -(rxt(k,189)*y(k,136)) + mat(k,1057) = -rxt(k,189)*y(k,18) + mat(k,54) = -(rxt(k,164)*y(k,136)) + mat(k,1058) = -rxt(k,164)*y(k,19) + mat(k,57) = -(rxt(k,165)*y(k,136)) + mat(k,1059) = -rxt(k,165)*y(k,20) + mat(k,60) = -(rxt(k,166)*y(k,136)) + mat(k,1060) = -rxt(k,166)*y(k,21) + mat(k,63) = -(rxt(k,167)*y(k,136)) + mat(k,1061) = -rxt(k,167)*y(k,22) + mat(k,66) = -(rxt(k,168)*y(k,136)) + mat(k,1062) = -rxt(k,168)*y(k,23) + mat(k,227) = -(rxt(k,194)*y(k,38) + rxt(k,195)*y(k,137) + rxt(k,206)*y(k,136)) + mat(k,837) = -rxt(k,194)*y(k,24) + mat(k,1117) = -rxt(k,195)*y(k,24) + mat(k,1069) = -rxt(k,206)*y(k,24) + mat(k,783) = -(rxt(k,137)*y(k,38) + rxt(k,173)*y(k,4) + rxt(k,211)*y(k,90) & + + rxt(k,212)*y(k,97) + rxt(k,213)*y(k,137)) + mat(k,853) = -rxt(k,137)*y(k,25) + mat(k,799) = -rxt(k,173)*y(k,25) + mat(k,1206) = -rxt(k,211)*y(k,25) + mat(k,882) = -rxt(k,212)*y(k,25) + mat(k,1162) = -rxt(k,213)*y(k,25) + mat(k,223) = rxt(k,226)*y(k,98) + mat(k,536) = .500_r8*rxt(k,254)*y(k,98) + mat(k,305) = .500_r8*rxt(k,242)*y(k,137) + mat(k,249) = rxt(k,218)*y(k,137) + mat(k,203) = .300_r8*rxt(k,219)*y(k,137) + mat(k,482) = (rxt(k,222)+rxt(k,223))*y(k,136) + mat(k,1231) = rxt(k,144)*y(k,129) + mat(k,461) = .800_r8*rxt(k,247)*y(k,137) + mat(k,438) = .910_r8*rxt(k,304)*y(k,98) + mat(k,381) = .072_r8*rxt(k,297)*y(k,88) + .072_r8*rxt(k,298)*y(k,90) & + + .206_r8*rxt(k,296)*y(k,132) + mat(k,565) = .120_r8*rxt(k,279)*y(k,98) + mat(k,287) = .500_r8*rxt(k,288)*y(k,137) + mat(k,718) = .600_r8*rxt(k,289)*y(k,98) + mat(k,1273) = .072_r8*rxt(k,297)*y(k,72) + rxt(k,217)*y(k,129) & + + .500_r8*rxt(k,244)*y(k,131) + .550_r8*rxt(k,302)*y(k,133) & + + .250_r8*rxt(k,277)*y(k,134) + rxt(k,286)*y(k,135) + rxt(k,265) & + *y(k,138) + rxt(k,269)*y(k,139) + .250_r8*rxt(k,312)*y(k,140) + mat(k,1206) = mat(k,1206) + .072_r8*rxt(k,298)*y(k,72) + .600_r8*rxt(k,303) & + *y(k,133) + .250_r8*rxt(k,276)*y(k,134) + rxt(k,287)*y(k,135) + mat(k,1004) = rxt(k,226)*y(k,9) + .500_r8*rxt(k,254)*y(k,13) & + + .910_r8*rxt(k,304)*y(k,71) + .120_r8*rxt(k,279)*y(k,74) & + + .600_r8*rxt(k,289)*y(k,77) + mat(k,256) = rxt(k,249)*y(k,137) + mat(k,372) = .700_r8*rxt(k,228)*y(k,129) + mat(k,394) = rxt(k,255)*y(k,129) + mat(k,698) = rxt(k,238)*y(k,129) + .600_r8*rxt(k,299)*y(k,133) & + + .250_r8*rxt(k,273)*y(k,134) + rxt(k,282)*y(k,135) & + + .250_r8*rxt(k,309)*y(k,140) + mat(k,755) = rxt(k,144)*y(k,41) + rxt(k,217)*y(k,88) + .700_r8*rxt(k,228) & + *y(k,126) + rxt(k,255)*y(k,127) + rxt(k,238)*y(k,128) + ( & + + 4.000_r8*rxt(k,214)+2.000_r8*rxt(k,215))*y(k,129) & + + 1.200_r8*rxt(k,300)*y(k,133) + .880_r8*rxt(k,274)*y(k,134) & + + 2.000_r8*rxt(k,283)*y(k,135) + .800_r8*rxt(k,267)*y(k,139) & + + .800_r8*rxt(k,310)*y(k,140) + mat(k,330) = .500_r8*rxt(k,244)*y(k,88) + mat(k,938) = .206_r8*rxt(k,296)*y(k,72) + .450_r8*rxt(k,284)*y(k,135) & + + .150_r8*rxt(k,268)*y(k,139) + mat(k,632) = .550_r8*rxt(k,302)*y(k,88) + .600_r8*rxt(k,303)*y(k,90) & + + .600_r8*rxt(k,299)*y(k,128) + 1.200_r8*rxt(k,300)*y(k,129) + mat(k,653) = .250_r8*rxt(k,277)*y(k,88) + .250_r8*rxt(k,276)*y(k,90) & + + .250_r8*rxt(k,273)*y(k,128) + .880_r8*rxt(k,274)*y(k,129) + mat(k,671) = rxt(k,286)*y(k,88) + rxt(k,287)*y(k,90) + rxt(k,282)*y(k,128) & + + 2.000_r8*rxt(k,283)*y(k,129) + .450_r8*rxt(k,284)*y(k,132) & + + 4.000_r8*rxt(k,285)*y(k,135) + mat(k,1077) = (rxt(k,222)+rxt(k,223))*y(k,36) + mat(k,1162) = mat(k,1162) + .500_r8*rxt(k,242)*y(k,33) + rxt(k,218)*y(k,34) & + + .300_r8*rxt(k,219)*y(k,35) + .800_r8*rxt(k,247)*y(k,52) & + + .500_r8*rxt(k,288)*y(k,76) + rxt(k,249)*y(k,103) + mat(k,345) = rxt(k,265)*y(k,88) + mat(k,497) = rxt(k,269)*y(k,88) + .800_r8*rxt(k,267)*y(k,129) & + + .150_r8*rxt(k,268)*y(k,132) + mat(k,582) = .250_r8*rxt(k,312)*y(k,88) + .250_r8*rxt(k,309)*y(k,128) & + + .800_r8*rxt(k,310)*y(k,129) + mat(k,292) = -(rxt(k,196)*y(k,38) + rxt(k,197)*y(k,137) + rxt(k,207)*y(k,136)) + mat(k,839) = -rxt(k,196)*y(k,26) + mat(k,1125) = -rxt(k,197)*y(k,26) + mat(k,1070) = -rxt(k,207)*y(k,26) + mat(k,77) = -(rxt(k,198)*y(k,137)) + mat(k,1095) = -rxt(k,198)*y(k,27) + mat(k,550) = -(rxt(k,235)*y(k,90) + rxt(k,236)*y(k,137)) + mat(k,1194) = -rxt(k,235)*y(k,28) + mat(k,1150) = -rxt(k,236)*y(k,28) + mat(k,112) = rxt(k,231)*y(k,137) + mat(k,149) = .500_r8*rxt(k,232)*y(k,137) + mat(k,531) = .500_r8*rxt(k,254)*y(k,98) + mat(k,710) = .100_r8*rxt(k,289)*y(k,98) + mat(k,1262) = rxt(k,230)*y(k,126) + .270_r8*rxt(k,257)*y(k,127) + rxt(k,265) & + *y(k,138) + mat(k,992) = .500_r8*rxt(k,254)*y(k,13) + .100_r8*rxt(k,289)*y(k,77) + mat(k,370) = rxt(k,230)*y(k,88) + 3.200_r8*rxt(k,227)*y(k,126) & + + .800_r8*rxt(k,228)*y(k,129) + mat(k,391) = .270_r8*rxt(k,257)*y(k,88) + mat(k,744) = .800_r8*rxt(k,228)*y(k,126) + mat(k,1150) = mat(k,1150) + rxt(k,231)*y(k,10) + .500_r8*rxt(k,232)*y(k,11) + mat(k,344) = rxt(k,265)*y(k,88) + mat(k,168) = -(rxt(k,199)*y(k,38) + rxt(k,200)*y(k,137)) + mat(k,834) = -rxt(k,199)*y(k,29) + mat(k,1108) = -rxt(k,200)*y(k,29) + mat(k,360) = -(rxt(k,272)*y(k,137)) + mat(k,1133) = -rxt(k,272)*y(k,30) + mat(k,1253) = .820_r8*rxt(k,257)*y(k,127) + mat(k,309) = .100_r8*rxt(k,317)*y(k,137) + mat(k,388) = .820_r8*rxt(k,257)*y(k,88) + .820_r8*rxt(k,255)*y(k,129) + mat(k,737) = .820_r8*rxt(k,255)*y(k,127) + mat(k,1133) = mat(k,1133) + .100_r8*rxt(k,317)*y(k,122) + mat(k,591) = -(rxt(k,260)*y(k,90) + rxt(k,261)*y(k,137)) + mat(k,1197) = -rxt(k,260)*y(k,31) + mat(k,1153) = -rxt(k,261)*y(k,31) + mat(k,504) = rxt(k,262)*y(k,137) + mat(k,561) = .880_r8*rxt(k,279)*y(k,98) + mat(k,711) = .500_r8*rxt(k,289)*y(k,98) + mat(k,1265) = .020_r8*rxt(k,302)*y(k,133) + .250_r8*rxt(k,277)*y(k,134) & + + .250_r8*rxt(k,312)*y(k,140) + mat(k,1197) = mat(k,1197) + .250_r8*rxt(k,276)*y(k,134) + .250_r8*rxt(k,313) & + *y(k,140) + mat(k,195) = rxt(k,263)*y(k,137) + mat(k,995) = .880_r8*rxt(k,279)*y(k,74) + .500_r8*rxt(k,289)*y(k,77) + mat(k,691) = .250_r8*rxt(k,273)*y(k,134) + .250_r8*rxt(k,309)*y(k,140) + mat(k,747) = .240_r8*rxt(k,274)*y(k,134) + .500_r8*rxt(k,267)*y(k,139) & + + .100_r8*rxt(k,310)*y(k,140) + mat(k,625) = .020_r8*rxt(k,302)*y(k,88) + mat(k,648) = .250_r8*rxt(k,277)*y(k,88) + .250_r8*rxt(k,276)*y(k,90) & + + .250_r8*rxt(k,273)*y(k,128) + .240_r8*rxt(k,274)*y(k,129) + mat(k,1153) = mat(k,1153) + rxt(k,262)*y(k,69) + rxt(k,263)*y(k,91) + mat(k,494) = .500_r8*rxt(k,267)*y(k,129) + mat(k,579) = .250_r8*rxt(k,312)*y(k,88) + .250_r8*rxt(k,313)*y(k,90) & + + .250_r8*rxt(k,309)*y(k,128) + .100_r8*rxt(k,310)*y(k,129) + end do + end subroutine nlnmat01 + subroutine nlnmat02( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,318) = -(rxt(k,241)*y(k,137)) + mat(k,1128) = -rxt(k,241)*y(k,32) + mat(k,523) = .120_r8*rxt(k,254)*y(k,98) + mat(k,978) = .120_r8*rxt(k,254)*y(k,13) + mat(k,683) = .100_r8*rxt(k,238)*y(k,129) + .150_r8*rxt(k,239)*y(k,132) + mat(k,734) = .100_r8*rxt(k,238)*y(k,128) + mat(k,910) = .150_r8*rxt(k,239)*y(k,128) + .150_r8*rxt(k,284)*y(k,135) + mat(k,663) = .150_r8*rxt(k,284)*y(k,132) + mat(k,301) = -(rxt(k,242)*y(k,137)) + mat(k,1126) = -rxt(k,242)*y(k,33) + mat(k,682) = .400_r8*rxt(k,239)*y(k,132) + mat(k,909) = .400_r8*rxt(k,239)*y(k,128) + .400_r8*rxt(k,284)*y(k,135) + mat(k,662) = .400_r8*rxt(k,284)*y(k,132) + mat(k,248) = -(rxt(k,218)*y(k,137)) + mat(k,1120) = -rxt(k,218)*y(k,34) + mat(k,368) = .300_r8*rxt(k,228)*y(k,129) + mat(k,733) = .300_r8*rxt(k,228)*y(k,126) + 2.000_r8*rxt(k,215)*y(k,129) & + + .250_r8*rxt(k,300)*y(k,133) + .250_r8*rxt(k,274)*y(k,134) & + + .500_r8*rxt(k,267)*y(k,139) + .300_r8*rxt(k,310)*y(k,140) + mat(k,617) = .250_r8*rxt(k,300)*y(k,129) + mat(k,642) = .250_r8*rxt(k,274)*y(k,129) + mat(k,491) = .500_r8*rxt(k,267)*y(k,129) + mat(k,572) = .300_r8*rxt(k,310)*y(k,129) + mat(k,200) = -(rxt(k,219)*y(k,137)) + mat(k,1113) = -rxt(k,219)*y(k,35) + mat(k,732) = rxt(k,216)*y(k,132) + mat(k,904) = rxt(k,216)*y(k,129) + mat(k,477) = -(rxt(k,138)*y(k,38) + rxt(k,220)*y(k,137) + (rxt(k,221) & + + rxt(k,222) + rxt(k,223)) * y(k,136)) + mat(k,845) = -rxt(k,138)*y(k,36) + mat(k,1144) = -rxt(k,220)*y(k,36) + mat(k,1072) = -(rxt(k,221) + rxt(k,222) + rxt(k,223)) * y(k,36) + mat(k,526) = .100_r8*rxt(k,254)*y(k,98) + mat(k,986) = .100_r8*rxt(k,254)*y(k,13) + mat(k,182) = -(rxt(k,190)*y(k,136) + rxt(k,201)*y(k,38) + rxt(k,202)*y(k,137)) + mat(k,1068) = -rxt(k,190)*y(k,37) + mat(k,835) = -rxt(k,201)*y(k,37) + mat(k,1110) = -rxt(k,202)*y(k,37) + mat(k,856) = -(rxt(k,137)*y(k,25) + rxt(k,138)*y(k,36) + rxt(k,139)*y(k,55) & + + rxt(k,140)*y(k,57) + (rxt(k,141) + rxt(k,142)) * y(k,132) & + + rxt(k,143)*y(k,98) + rxt(k,150)*y(k,42) + rxt(k,159)*y(k,68) & + + rxt(k,194)*y(k,24) + rxt(k,196)*y(k,26) + rxt(k,199)*y(k,29) & + + rxt(k,201)*y(k,37) + rxt(k,233)*y(k,12)) + mat(k,786) = -rxt(k,137)*y(k,38) + mat(k,484) = -rxt(k,138)*y(k,38) + mat(k,517) = -rxt(k,139)*y(k,38) + mat(k,278) = -rxt(k,140)*y(k,38) + mat(k,941) = -(rxt(k,141) + rxt(k,142)) * y(k,38) + mat(k,1007) = -rxt(k,143)*y(k,38) + mat(k,450) = -rxt(k,150)*y(k,38) + mat(k,403) = -rxt(k,159)*y(k,38) + mat(k,230) = -rxt(k,194)*y(k,38) + mat(k,296) = -rxt(k,196)*y(k,38) + mat(k,172) = -rxt(k,199)*y(k,38) + mat(k,185) = -rxt(k,201)*y(k,38) + mat(k,133) = -rxt(k,233)*y(k,38) + mat(k,963) = rxt(k,178)*y(k,41) + mat(k,49) = 4.000_r8*rxt(k,162)*y(k,136) + mat(k,75) = rxt(k,163)*y(k,136) + mat(k,55) = 3.000_r8*rxt(k,164)*y(k,136) + mat(k,58) = 3.000_r8*rxt(k,165)*y(k,136) + mat(k,61) = 2.000_r8*rxt(k,166)*y(k,136) + mat(k,64) = rxt(k,167)*y(k,136) + mat(k,67) = 2.000_r8*rxt(k,168)*y(k,136) + mat(k,78) = 3.000_r8*rxt(k,198)*y(k,137) + mat(k,172) = mat(k,172) + rxt(k,200)*y(k,137) + mat(k,1234) = rxt(k,178)*y(k,6) + (4.000_r8*rxt(k,145)+2.000_r8*rxt(k,147)) & + *y(k,41) + rxt(k,149)*y(k,88) + rxt(k,154)*y(k,97) + rxt(k,326) & + *y(k,110) + rxt(k,144)*y(k,129) + rxt(k,155)*y(k,137) + mat(k,90) = 2.000_r8*rxt(k,208)*y(k,136) + 2.000_r8*rxt(k,203)*y(k,137) + mat(k,94) = rxt(k,209)*y(k,136) + rxt(k,204)*y(k,137) + mat(k,104) = rxt(k,210)*y(k,136) + rxt(k,205)*y(k,137) + mat(k,821) = rxt(k,157)*y(k,97) + rxt(k,169)*y(k,136) + rxt(k,158)*y(k,137) + mat(k,1276) = rxt(k,149)*y(k,41) + mat(k,885) = rxt(k,154)*y(k,41) + rxt(k,157)*y(k,63) + mat(k,605) = rxt(k,326)*y(k,41) + mat(k,757) = rxt(k,144)*y(k,41) + mat(k,1080) = 4.000_r8*rxt(k,162)*y(k,16) + rxt(k,163)*y(k,17) & + + 3.000_r8*rxt(k,164)*y(k,19) + 3.000_r8*rxt(k,165)*y(k,20) & + + 2.000_r8*rxt(k,166)*y(k,21) + rxt(k,167)*y(k,22) & + + 2.000_r8*rxt(k,168)*y(k,23) + 2.000_r8*rxt(k,208)*y(k,60) & + + rxt(k,209)*y(k,61) + rxt(k,210)*y(k,62) + rxt(k,169)*y(k,63) + mat(k,1165) = 3.000_r8*rxt(k,198)*y(k,27) + rxt(k,200)*y(k,29) + rxt(k,155) & + *y(k,41) + 2.000_r8*rxt(k,203)*y(k,60) + rxt(k,204)*y(k,61) & + + rxt(k,205)*y(k,62) + rxt(k,158)*y(k,63) + mat(k,832) = rxt(k,150)*y(k,42) + mat(k,1222) = 2.000_r8*rxt(k,146)*y(k,41) + mat(k,445) = rxt(k,150)*y(k,38) + (rxt(k,349)+rxt(k,354)+rxt(k,359))*y(k,63) + mat(k,812) = (rxt(k,349)+rxt(k,354)+rxt(k,359))*y(k,42) + (rxt(k,344) & + +rxt(k,350)+rxt(k,355))*y(k,68) + mat(k,400) = (rxt(k,344)+rxt(k,350)+rxt(k,355))*y(k,63) + mat(k,1221) = 2.000_r8*rxt(k,171)*y(k,41) + mat(k,1243) = -(rxt(k,144)*y(k,129) + (4._r8*rxt(k,145) + 4._r8*rxt(k,146) & + + 4._r8*rxt(k,147) + 4._r8*rxt(k,171)) * y(k,41) + rxt(k,148) & + *y(k,132) + rxt(k,149)*y(k,88) + rxt(k,151)*y(k,89) + rxt(k,154) & + *y(k,97) + (rxt(k,155) + rxt(k,156)) * y(k,137) + (rxt(k,177) & + + rxt(k,178) + rxt(k,179)) * y(k,6) + rxt(k,326)*y(k,110)) + mat(k,765) = -rxt(k,144)*y(k,41) + mat(k,950) = -rxt(k,148)*y(k,41) + mat(k,1285) = -rxt(k,149)*y(k,41) + mat(k,1052) = -rxt(k,151)*y(k,41) + mat(k,894) = -rxt(k,154)*y(k,41) + mat(k,1174) = -(rxt(k,155) + rxt(k,156)) * y(k,41) + mat(k,972) = -(rxt(k,177) + rxt(k,178) + rxt(k,179)) * y(k,41) + mat(k,612) = -rxt(k,326)*y(k,41) + mat(k,865) = rxt(k,159)*y(k,68) + rxt(k,143)*y(k,98) + rxt(k,142)*y(k,132) + mat(k,455) = rxt(k,152)*y(k,97) + mat(k,830) = rxt(k,170)*y(k,136) + mat(k,406) = rxt(k,159)*y(k,38) + rxt(k,160)*y(k,97) + rxt(k,161)*y(k,137) + mat(k,894) = mat(k,894) + rxt(k,152)*y(k,42) + rxt(k,160)*y(k,68) + mat(k,1016) = rxt(k,143)*y(k,38) + mat(k,156) = rxt(k,331)*y(k,110) + mat(k,612) = mat(k,612) + rxt(k,331)*y(k,100) + mat(k,950) = mat(k,950) + rxt(k,142)*y(k,38) + mat(k,1089) = rxt(k,170)*y(k,63) + mat(k,1174) = mat(k,1174) + rxt(k,161)*y(k,68) + mat(k,448) = -(rxt(k,150)*y(k,38) + rxt(k,152)*y(k,97) + rxt(k,153)*y(k,137) & + + (rxt(k,349) + rxt(k,354) + rxt(k,359)) * y(k,63)) + mat(k,843) = -rxt(k,150)*y(k,42) + mat(k,877) = -rxt(k,152)*y(k,42) + mat(k,1141) = -rxt(k,153)*y(k,42) + mat(k,817) = -(rxt(k,349) + rxt(k,354) + rxt(k,359)) * y(k,42) + mat(k,1227) = rxt(k,151)*y(k,89) + mat(k,1030) = rxt(k,151)*y(k,41) + mat(k,510) = -(rxt(k,224)*y(k,137)) + mat(k,1147) = -rxt(k,224)*y(k,44) + mat(k,797) = rxt(k,173)*y(k,25) + mat(k,222) = .630_r8*rxt(k,226)*y(k,98) + mat(k,528) = .560_r8*rxt(k,254)*y(k,98) + mat(k,780) = rxt(k,173)*y(k,4) + rxt(k,137)*y(k,38) + rxt(k,211)*y(k,90) & + + rxt(k,212)*y(k,97) + rxt(k,213)*y(k,137) + mat(k,169) = rxt(k,199)*y(k,38) + mat(k,590) = rxt(k,260)*y(k,90) + rxt(k,261)*y(k,137) + mat(k,846) = rxt(k,137)*y(k,25) + rxt(k,199)*y(k,29) + mat(k,337) = rxt(k,248)*y(k,137) + mat(k,431) = .620_r8*rxt(k,304)*y(k,98) + mat(k,559) = .650_r8*rxt(k,279)*y(k,98) + mat(k,708) = .560_r8*rxt(k,289)*y(k,98) + mat(k,1261) = .220_r8*rxt(k,277)*y(k,134) + .250_r8*rxt(k,312)*y(k,140) + mat(k,1192) = rxt(k,211)*y(k,25) + rxt(k,260)*y(k,31) + .220_r8*rxt(k,276) & + *y(k,134) + .500_r8*rxt(k,313)*y(k,140) + mat(k,878) = rxt(k,212)*y(k,25) + rxt(k,320)*y(k,101) + mat(k,989) = .630_r8*rxt(k,226)*y(k,9) + .560_r8*rxt(k,254)*y(k,13) & + + .620_r8*rxt(k,304)*y(k,71) + .650_r8*rxt(k,279)*y(k,74) & + + .560_r8*rxt(k,289)*y(k,77) + mat(k,163) = rxt(k,320)*y(k,97) + rxt(k,321)*y(k,137) + mat(k,688) = .220_r8*rxt(k,273)*y(k,134) + .250_r8*rxt(k,309)*y(k,140) + mat(k,743) = .110_r8*rxt(k,274)*y(k,134) + .200_r8*rxt(k,310)*y(k,140) + mat(k,646) = .220_r8*rxt(k,277)*y(k,88) + .220_r8*rxt(k,276)*y(k,90) & + + .220_r8*rxt(k,273)*y(k,128) + .110_r8*rxt(k,274)*y(k,129) + mat(k,1147) = mat(k,1147) + rxt(k,213)*y(k,25) + rxt(k,261)*y(k,31) & + + rxt(k,248)*y(k,53) + rxt(k,321)*y(k,101) + mat(k,577) = .250_r8*rxt(k,312)*y(k,88) + .500_r8*rxt(k,313)*y(k,90) & + + .250_r8*rxt(k,309)*y(k,128) + .200_r8*rxt(k,310)*y(k,129) + mat(k,524) = .200_r8*rxt(k,254)*y(k,98) + mat(k,319) = rxt(k,241)*y(k,137) + mat(k,302) = .500_r8*rxt(k,242)*y(k,137) + mat(k,509) = rxt(k,224)*y(k,137) + mat(k,457) = .800_r8*rxt(k,247)*y(k,137) + mat(k,335) = rxt(k,248)*y(k,137) + mat(k,284) = .500_r8*rxt(k,288)*y(k,137) + mat(k,707) = .100_r8*rxt(k,289)*y(k,98) + mat(k,1249) = rxt(k,240)*y(k,128) + mat(k,979) = .200_r8*rxt(k,254)*y(k,13) + .100_r8*rxt(k,289)*y(k,77) + mat(k,684) = rxt(k,240)*y(k,88) + 4.000_r8*rxt(k,237)*y(k,128) & + + .900_r8*rxt(k,238)*y(k,129) + 2.000_r8*rxt(k,282)*y(k,135) & + + rxt(k,309)*y(k,140) + mat(k,735) = .900_r8*rxt(k,238)*y(k,128) + rxt(k,283)*y(k,135) + mat(k,911) = .450_r8*rxt(k,284)*y(k,135) + mat(k,664) = 2.000_r8*rxt(k,282)*y(k,128) + rxt(k,283)*y(k,129) & + + .450_r8*rxt(k,284)*y(k,132) + 4.000_r8*rxt(k,285)*y(k,135) + mat(k,1129) = rxt(k,241)*y(k,32) + .500_r8*rxt(k,242)*y(k,33) + rxt(k,224) & + *y(k,44) + .800_r8*rxt(k,247)*y(k,52) + rxt(k,248)*y(k,53) & + + .500_r8*rxt(k,288)*y(k,76) + mat(k,573) = rxt(k,309)*y(k,128) + mat(k,136) = -(rxt(k,318)*y(k,90) + (rxt(k,319) + rxt(k,333)) * y(k,137)) + mat(k,1178) = -rxt(k,318)*y(k,46) + mat(k,1103) = -(rxt(k,319) + rxt(k,333)) * y(k,46) + mat(k,326) = rxt(k,243)*y(k,132) + mat(k,897) = rxt(k,243)*y(k,131) + mat(k,459) = -(rxt(k,247)*y(k,137)) + mat(k,1142) = -rxt(k,247)*y(k,52) + mat(k,1257) = .020_r8*rxt(k,302)*y(k,133) + .530_r8*rxt(k,277)*y(k,134) & + + .250_r8*rxt(k,312)*y(k,140) + mat(k,1188) = .530_r8*rxt(k,276)*y(k,134) + .250_r8*rxt(k,313)*y(k,140) + mat(k,686) = .530_r8*rxt(k,273)*y(k,134) + .250_r8*rxt(k,309)*y(k,140) + mat(k,740) = .260_r8*rxt(k,274)*y(k,134) + .100_r8*rxt(k,310)*y(k,140) + mat(k,619) = .020_r8*rxt(k,302)*y(k,88) + mat(k,643) = .530_r8*rxt(k,277)*y(k,88) + .530_r8*rxt(k,276)*y(k,90) & + + .530_r8*rxt(k,273)*y(k,128) + .260_r8*rxt(k,274)*y(k,129) + mat(k,575) = .250_r8*rxt(k,312)*y(k,88) + .250_r8*rxt(k,313)*y(k,90) & + + .250_r8*rxt(k,309)*y(k,128) + .100_r8*rxt(k,310)*y(k,129) + mat(k,336) = -(rxt(k,248)*y(k,137)) + mat(k,1131) = -rxt(k,248)*y(k,53) + mat(k,458) = .200_r8*rxt(k,247)*y(k,137) + mat(k,1251) = .020_r8*rxt(k,302)*y(k,133) + .250_r8*rxt(k,312)*y(k,140) + mat(k,1182) = .250_r8*rxt(k,313)*y(k,140) + mat(k,685) = .250_r8*rxt(k,309)*y(k,140) + mat(k,736) = .100_r8*rxt(k,310)*y(k,140) + mat(k,618) = .020_r8*rxt(k,302)*y(k,88) + mat(k,1131) = mat(k,1131) + .200_r8*rxt(k,247)*y(k,52) + mat(k,574) = .250_r8*rxt(k,312)*y(k,88) + .250_r8*rxt(k,313)*y(k,90) & + + .250_r8*rxt(k,309)*y(k,128) + .100_r8*rxt(k,310)*y(k,129) + end do + end subroutine nlnmat02 + subroutine nlnmat03( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,769) = -((rxt(k,97) + rxt(k,98) + rxt(k,99)) * y(k,132) + rxt(k,103) & + *y(k,98)) + mat(k,937) = -(rxt(k,97) + rxt(k,98) + rxt(k,99)) * y(k,54) + mat(k,1003) = -rxt(k,103)*y(k,54) + mat(k,782) = rxt(k,213)*y(k,137) + mat(k,481) = rxt(k,222)*y(k,136) + mat(k,852) = rxt(k,139)*y(k,55) + mat(k,515) = rxt(k,139)*y(k,38) + rxt(k,95)*y(k,97) + rxt(k,86)*y(k,136) & + + rxt(k,104)*y(k,137) + mat(k,409) = rxt(k,193)*y(k,136) + mat(k,818) = rxt(k,170)*y(k,136) + mat(k,214) = rxt(k,125)*y(k,137) + mat(k,881) = rxt(k,95)*y(k,55) + rxt(k,107)*y(k,137) + mat(k,165) = rxt(k,321)*y(k,137) + mat(k,236) = rxt(k,327)*y(k,137) + mat(k,603) = rxt(k,332)*y(k,137) + mat(k,1076) = rxt(k,222)*y(k,36) + rxt(k,86)*y(k,55) + rxt(k,193)*y(k,59) & + + rxt(k,170)*y(k,63) + mat(k,1161) = rxt(k,213)*y(k,25) + rxt(k,104)*y(k,55) + rxt(k,125)*y(k,78) & + + rxt(k,107)*y(k,97) + rxt(k,321)*y(k,101) + rxt(k,327)*y(k,108) & + + rxt(k,332)*y(k,110) + mat(k,514) = -(rxt(k,86)*y(k,136) + rxt(k,95)*y(k,97) + rxt(k,104)*y(k,137) & + + rxt(k,139)*y(k,38)) + mat(k,1074) = -rxt(k,86)*y(k,55) + mat(k,879) = -rxt(k,95)*y(k,55) + mat(k,1148) = -rxt(k,104)*y(k,55) + mat(k,847) = -rxt(k,139)*y(k,55) + mat(k,479) = rxt(k,223)*y(k,136) + mat(k,768) = rxt(k,97)*y(k,132) + mat(k,926) = rxt(k,97)*y(k,54) + mat(k,1074) = mat(k,1074) + rxt(k,223)*y(k,36) + mat(k,42) = -(rxt(k,191)*y(k,136)) + mat(k,1055) = -rxt(k,191)*y(k,56) + mat(k,276) = -(rxt(k,96)*y(k,97) + rxt(k,105)*y(k,137) + rxt(k,140)*y(k,38)) + mat(k,871) = -rxt(k,96)*y(k,57) + mat(k,1123) = -rxt(k,105)*y(k,57) + mat(k,838) = -rxt(k,140)*y(k,57) + mat(k,908) = 2.000_r8*rxt(k,111)*y(k,132) + mat(k,1123) = mat(k,1123) + 2.000_r8*rxt(k,110)*y(k,137) + mat(k,115) = rxt(k,334)*y(k,141) + mat(k,1288) = rxt(k,334)*y(k,112) + mat(k,408) = -(rxt(k,186)*y(k,97) + rxt(k,187)*y(k,137) + (rxt(k,192) & + + rxt(k,193)) * y(k,136)) + mat(k,874) = -rxt(k,186)*y(k,59) + mat(k,1137) = -rxt(k,187)*y(k,59) + mat(k,1071) = -(rxt(k,192) + rxt(k,193)) * y(k,59) + mat(k,796) = rxt(k,173)*y(k,25) + rxt(k,174)*y(k,132) + mat(k,778) = rxt(k,173)*y(k,4) + mat(k,920) = rxt(k,174)*y(k,4) + mat(k,89) = -(rxt(k,203)*y(k,137) + rxt(k,208)*y(k,136)) + mat(k,1096) = -rxt(k,203)*y(k,60) + mat(k,1064) = -rxt(k,208)*y(k,60) + mat(k,93) = -(rxt(k,204)*y(k,137) + rxt(k,209)*y(k,136)) + mat(k,1097) = -rxt(k,204)*y(k,61) + mat(k,1065) = -rxt(k,209)*y(k,61) + mat(k,103) = -(rxt(k,205)*y(k,137) + rxt(k,210)*y(k,136)) + mat(k,1099) = -rxt(k,205)*y(k,62) + mat(k,1067) = -rxt(k,210)*y(k,62) + mat(k,820) = -(rxt(k,157)*y(k,97) + rxt(k,158)*y(k,137) + (rxt(k,169) & + + rxt(k,170)) * y(k,136) + (rxt(k,344) + rxt(k,350) + rxt(k,355) & + ) * y(k,68) + (rxt(k,349) + rxt(k,354) + rxt(k,359)) * y(k,42) & + + (rxt(k,351) + rxt(k,356)) * y(k,67)) + mat(k,884) = -rxt(k,157)*y(k,63) + mat(k,1164) = -rxt(k,158)*y(k,63) + mat(k,1079) = -(rxt(k,169) + rxt(k,170)) * y(k,63) + mat(k,402) = -(rxt(k,344) + rxt(k,350) + rxt(k,355)) * y(k,63) + mat(k,449) = -(rxt(k,349) + rxt(k,354) + rxt(k,359)) * y(k,63) + mat(k,354) = -(rxt(k,351) + rxt(k,356)) * y(k,63) + mat(k,132) = rxt(k,233)*y(k,38) + mat(k,229) = rxt(k,194)*y(k,38) + mat(k,785) = rxt(k,137)*y(k,38) + mat(k,295) = rxt(k,196)*y(k,38) + mat(k,171) = 2.000_r8*rxt(k,199)*y(k,38) + mat(k,483) = rxt(k,138)*y(k,38) + mat(k,184) = rxt(k,201)*y(k,38) + mat(k,855) = rxt(k,233)*y(k,12) + rxt(k,194)*y(k,24) + rxt(k,137)*y(k,25) & + + rxt(k,196)*y(k,26) + 2.000_r8*rxt(k,199)*y(k,29) + rxt(k,138) & + *y(k,36) + rxt(k,201)*y(k,37) + rxt(k,139)*y(k,55) + rxt(k,140) & + *y(k,57) + rxt(k,159)*y(k,68) + rxt(k,141)*y(k,132) + mat(k,1233) = rxt(k,156)*y(k,137) + mat(k,516) = rxt(k,139)*y(k,38) + mat(k,277) = rxt(k,140)*y(k,38) + mat(k,402) = mat(k,402) + rxt(k,159)*y(k,38) + mat(k,940) = rxt(k,141)*y(k,38) + mat(k,1164) = mat(k,1164) + rxt(k,156)*y(k,41) + mat(k,416) = -(rxt(k,134)*y(k,137)) + mat(k,1138) = -rxt(k,134)*y(k,65) + mat(k,779) = rxt(k,211)*y(k,90) + mat(k,548) = rxt(k,235)*y(k,90) + mat(k,589) = rxt(k,260)*y(k,90) + mat(k,447) = (rxt(k,349)+rxt(k,354)+rxt(k,359))*y(k,63) + mat(k,137) = rxt(k,318)*y(k,90) + mat(k,816) = (rxt(k,349)+rxt(k,354)+rxt(k,359))*y(k,42) + mat(k,1028) = rxt(k,133)*y(k,137) + mat(k,1185) = rxt(k,211)*y(k,25) + rxt(k,235)*y(k,28) + rxt(k,260)*y(k,31) & + + rxt(k,318)*y(k,46) + mat(k,1138) = mat(k,1138) + rxt(k,133)*y(k,89) + mat(k,176) = -(rxt(k,112)*y(k,137)) + mat(k,1109) = -rxt(k,112)*y(k,66) + mat(k,1021) = rxt(k,131)*y(k,132) + mat(k,902) = rxt(k,131)*y(k,89) + mat(k,352) = -(rxt(k,188)*y(k,97) + (rxt(k,351) + rxt(k,356)) * y(k,63)) + mat(k,872) = -rxt(k,188)*y(k,67) + mat(k,814) = -(rxt(k,351) + rxt(k,356)) * y(k,67) + mat(k,956) = rxt(k,180)*y(k,132) + mat(k,914) = rxt(k,180)*y(k,6) + mat(k,401) = -(rxt(k,159)*y(k,38) + rxt(k,160)*y(k,97) + rxt(k,161)*y(k,137) & + + (rxt(k,344) + rxt(k,350) + rxt(k,355)) * y(k,63)) + mat(k,842) = -rxt(k,159)*y(k,68) + mat(k,873) = -rxt(k,160)*y(k,68) + mat(k,1136) = -rxt(k,161)*y(k,68) + mat(k,815) = -(rxt(k,344) + rxt(k,350) + rxt(k,355)) * y(k,68) + mat(k,1225) = rxt(k,148)*y(k,132) + mat(k,446) = rxt(k,153)*y(k,137) + mat(k,919) = rxt(k,148)*y(k,41) + mat(k,1136) = mat(k,1136) + rxt(k,153)*y(k,42) + mat(k,503) = -(rxt(k,262)*y(k,137)) + mat(k,1146) = -rxt(k,262)*y(k,69) + mat(k,285) = .500_r8*rxt(k,288)*y(k,137) + mat(k,1260) = .020_r8*rxt(k,302)*y(k,133) + .220_r8*rxt(k,277)*y(k,134) & + + .250_r8*rxt(k,312)*y(k,140) + mat(k,1191) = .220_r8*rxt(k,276)*y(k,134) + .250_r8*rxt(k,313)*y(k,140) + mat(k,262) = .500_r8*rxt(k,266)*y(k,137) + mat(k,687) = .220_r8*rxt(k,273)*y(k,134) + .250_r8*rxt(k,309)*y(k,140) + mat(k,742) = .230_r8*rxt(k,274)*y(k,134) + .200_r8*rxt(k,267)*y(k,139) & + + .100_r8*rxt(k,310)*y(k,140) + mat(k,621) = .020_r8*rxt(k,302)*y(k,88) + mat(k,645) = .220_r8*rxt(k,277)*y(k,88) + .220_r8*rxt(k,276)*y(k,90) & + + .220_r8*rxt(k,273)*y(k,128) + .230_r8*rxt(k,274)*y(k,129) + mat(k,1146) = mat(k,1146) + .500_r8*rxt(k,288)*y(k,76) + .500_r8*rxt(k,266) & + *y(k,106) + mat(k,493) = .200_r8*rxt(k,267)*y(k,129) + mat(k,576) = .250_r8*rxt(k,312)*y(k,88) + .250_r8*rxt(k,313)*y(k,90) & + + .250_r8*rxt(k,309)*y(k,128) + .100_r8*rxt(k,310)*y(k,129) + mat(k,157) = -(rxt(k,294)*y(k,137)) + mat(k,1106) = -rxt(k,294)*y(k,70) + mat(k,1247) = .330_r8*rxt(k,302)*y(k,133) + mat(k,1179) = rxt(k,307)*y(k,102) + .400_r8*rxt(k,303)*y(k,133) + mat(k,465) = rxt(k,307)*y(k,90) + rxt(k,308)*y(k,137) + mat(k,680) = .400_r8*rxt(k,299)*y(k,133) + mat(k,731) = .300_r8*rxt(k,300)*y(k,133) + mat(k,615) = .330_r8*rxt(k,302)*y(k,88) + .400_r8*rxt(k,303)*y(k,90) & + + .400_r8*rxt(k,299)*y(k,128) + .300_r8*rxt(k,300)*y(k,129) + mat(k,1106) = mat(k,1106) + rxt(k,308)*y(k,102) + mat(k,429) = -(rxt(k,295)*y(k,90) + rxt(k,304)*y(k,98) + rxt(k,305)*y(k,137)) + mat(k,1187) = -rxt(k,295)*y(k,71) + mat(k,983) = -rxt(k,304)*y(k,71) + mat(k,1140) = -rxt(k,305)*y(k,71) + mat(k,377) = -(rxt(k,296)*y(k,132) + rxt(k,297)*y(k,88) + rxt(k,298)*y(k,90)) + mat(k,917) = -rxt(k,296)*y(k,72) + mat(k,1255) = -rxt(k,297)*y(k,72) + mat(k,1184) = -rxt(k,298)*y(k,72) + mat(k,428) = rxt(k,295)*y(k,90) + mat(k,1184) = mat(k,1184) + rxt(k,295)*y(k,71) + mat(k,240) = -(rxt(k,306)*y(k,137)) + mat(k,1119) = -rxt(k,306)*y(k,73) + mat(k,906) = rxt(k,301)*y(k,133) + mat(k,616) = rxt(k,301)*y(k,132) + mat(k,560) = -(rxt(k,279)*y(k,98) + rxt(k,280)*y(k,137)) + mat(k,993) = -rxt(k,279)*y(k,74) + mat(k,1151) = -rxt(k,280)*y(k,74) + mat(k,433) = .300_r8*rxt(k,304)*y(k,98) + mat(k,379) = .167_r8*rxt(k,297)*y(k,88) + .167_r8*rxt(k,298)*y(k,90) & + + .167_r8*rxt(k,296)*y(k,132) + mat(k,1263) = .167_r8*rxt(k,297)*y(k,72) + .230_r8*rxt(k,302)*y(k,133) + mat(k,1195) = .167_r8*rxt(k,298)*y(k,72) + .250_r8*rxt(k,303)*y(k,133) + mat(k,993) = mat(k,993) + .300_r8*rxt(k,304)*y(k,71) + 1.122_r8*rxt(k,316) & + *y(k,122) + mat(k,310) = 1.122_r8*rxt(k,316)*y(k,98) + mat(k,689) = .250_r8*rxt(k,299)*y(k,133) + mat(k,745) = .190_r8*rxt(k,300)*y(k,133) + mat(k,928) = .167_r8*rxt(k,296)*y(k,72) + mat(k,623) = .230_r8*rxt(k,302)*y(k,88) + .250_r8*rxt(k,303)*y(k,90) & + + .250_r8*rxt(k,299)*y(k,128) + .190_r8*rxt(k,300)*y(k,129) + mat(k,142) = -(rxt(k,281)*y(k,137)) + mat(k,1104) = -rxt(k,281)*y(k,75) + mat(k,900) = rxt(k,275)*y(k,134) + mat(k,641) = rxt(k,275)*y(k,132) + mat(k,283) = -(rxt(k,288)*y(k,137)) + mat(k,1124) = -rxt(k,288)*y(k,76) + mat(k,1025) = rxt(k,291)*y(k,135) + mat(k,661) = rxt(k,291)*y(k,89) + mat(k,715) = -(rxt(k,289)*y(k,98) + rxt(k,290)*y(k,137)) + mat(k,1001) = -rxt(k,289)*y(k,77) + mat(k,1159) = -rxt(k,290)*y(k,77) + mat(k,436) = .200_r8*rxt(k,304)*y(k,98) + mat(k,380) = .039_r8*rxt(k,297)*y(k,88) + .039_r8*rxt(k,298)*y(k,90) & + + .039_r8*rxt(k,296)*y(k,132) + mat(k,1270) = .039_r8*rxt(k,297)*y(k,72) + .320_r8*rxt(k,302)*y(k,133) + mat(k,1203) = .039_r8*rxt(k,298)*y(k,72) + .350_r8*rxt(k,303)*y(k,133) + mat(k,1001) = mat(k,1001) + .200_r8*rxt(k,304)*y(k,71) + .442_r8*rxt(k,316) & + *y(k,122) + mat(k,312) = .442_r8*rxt(k,316)*y(k,98) + mat(k,696) = .350_r8*rxt(k,299)*y(k,133) + mat(k,752) = .260_r8*rxt(k,300)*y(k,133) + mat(k,935) = .039_r8*rxt(k,296)*y(k,72) + mat(k,630) = .320_r8*rxt(k,302)*y(k,88) + .350_r8*rxt(k,303)*y(k,90) & + + .350_r8*rxt(k,299)*y(k,128) + .260_r8*rxt(k,300)*y(k,129) + mat(k,213) = -(rxt(k,113)*y(k,88) + (rxt(k,114) + rxt(k,115) + rxt(k,116) & + ) * y(k,89) + rxt(k,125)*y(k,137)) + mat(k,1248) = -rxt(k,113)*y(k,78) + mat(k,1022) = -(rxt(k,114) + rxt(k,115) + rxt(k,116)) * y(k,78) + mat(k,1115) = -rxt(k,125)*y(k,78) + mat(k,97) = -((rxt(k,129) + rxt(k,130)) * y(k,136)) + mat(k,1066) = -(rxt(k,129) + rxt(k,130)) * y(k,79) + mat(k,212) = rxt(k,114)*y(k,89) + mat(k,1019) = rxt(k,114)*y(k,78) + end do + end subroutine nlnmat03 + subroutine nlnmat04( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,1020) = rxt(k,132)*y(k,90) + mat(k,1177) = rxt(k,132)*y(k,89) + mat(k,45) = -(rxt(k,335)*y(k,137)) + mat(k,1093) = -rxt(k,335)*y(k,84) + mat(k,1286) = -(rxt(k,113)*y(k,78) + rxt(k,122)*y(k,90) + rxt(k,126)*y(k,132) & + + rxt(k,127)*y(k,98) + rxt(k,128)*y(k,97) + rxt(k,149)*y(k,41) & + + rxt(k,181)*y(k,6) + rxt(k,217)*y(k,129) + rxt(k,230)*y(k,126) & + + rxt(k,240)*y(k,128) + rxt(k,244)*y(k,131) + rxt(k,257) & + *y(k,127) + rxt(k,265)*y(k,138) + rxt(k,269)*y(k,139) + (rxt(k,277) & + + rxt(k,278)) * y(k,134) + rxt(k,286)*y(k,135) + rxt(k,297) & + *y(k,72) + rxt(k,302)*y(k,133) + rxt(k,312)*y(k,140)) + mat(k,219) = -rxt(k,113)*y(k,88) + mat(k,1219) = -rxt(k,122)*y(k,88) + mat(k,951) = -rxt(k,126)*y(k,88) + mat(k,1017) = -rxt(k,127)*y(k,88) + mat(k,895) = -rxt(k,128)*y(k,88) + mat(k,1244) = -rxt(k,149)*y(k,88) + mat(k,973) = -rxt(k,181)*y(k,88) + mat(k,766) = -rxt(k,217)*y(k,88) + mat(k,376) = -rxt(k,230)*y(k,88) + mat(k,705) = -rxt(k,240)*y(k,88) + mat(k,334) = -rxt(k,244)*y(k,88) + mat(k,398) = -rxt(k,257)*y(k,88) + mat(k,349) = -rxt(k,265)*y(k,88) + mat(k,501) = -rxt(k,269)*y(k,88) + mat(k,659) = -(rxt(k,277) + rxt(k,278)) * y(k,88) + mat(k,678) = -rxt(k,286)*y(k,88) + mat(k,386) = -rxt(k,297)*y(k,88) + mat(k,639) = -rxt(k,302)*y(k,88) + mat(k,588) = -rxt(k,312)*y(k,88) + mat(k,219) = mat(k,219) + 2.000_r8*rxt(k,115)*y(k,89) + rxt(k,125)*y(k,137) + mat(k,99) = 2.000_r8*rxt(k,129)*y(k,136) + mat(k,1053) = 2.000_r8*rxt(k,115)*y(k,78) + rxt(k,118)*y(k,97) + rxt(k,328) & + *y(k,110) + mat(k,895) = mat(k,895) + rxt(k,118)*y(k,89) + mat(k,613) = rxt(k,328)*y(k,89) + mat(k,1090) = 2.000_r8*rxt(k,129)*y(k,79) + mat(k,1175) = rxt(k,125)*y(k,78) + mat(k,1048) = -((rxt(k,114) + rxt(k,115) + rxt(k,116)) * y(k,78) + (rxt(k,118) & + + rxt(k,120)) * y(k,97) + rxt(k,119)*y(k,98) + rxt(k,131) & + *y(k,132) + rxt(k,132)*y(k,90) + rxt(k,133)*y(k,137) + rxt(k,151) & + *y(k,41) + rxt(k,182)*y(k,6) + rxt(k,251)*y(k,128) + rxt(k,291) & + *y(k,135) + rxt(k,328)*y(k,110)) + mat(k,216) = -(rxt(k,114) + rxt(k,115) + rxt(k,116)) * y(k,89) + mat(k,890) = -(rxt(k,118) + rxt(k,120)) * y(k,89) + mat(k,1012) = -rxt(k,119)*y(k,89) + mat(k,946) = -rxt(k,131)*y(k,89) + mat(k,1214) = -rxt(k,132)*y(k,89) + mat(k,1170) = -rxt(k,133)*y(k,89) + mat(k,1239) = -rxt(k,151)*y(k,89) + mat(k,968) = -rxt(k,182)*y(k,89) + mat(k,702) = -rxt(k,251)*y(k,89) + mat(k,675) = -rxt(k,291)*y(k,89) + mat(k,610) = -rxt(k,328)*y(k,89) + mat(k,968) = mat(k,968) + rxt(k,181)*y(k,88) + mat(k,1239) = mat(k,1239) + rxt(k,149)*y(k,88) + mat(k,178) = rxt(k,112)*y(k,137) + mat(k,383) = 1.206_r8*rxt(k,297)*y(k,88) + 1.206_r8*rxt(k,298)*y(k,90) & + + .206_r8*rxt(k,296)*y(k,132) + mat(k,1281) = rxt(k,181)*y(k,6) + rxt(k,149)*y(k,41) + 1.206_r8*rxt(k,297) & + *y(k,72) + 2.000_r8*rxt(k,122)*y(k,90) + rxt(k,128)*y(k,97) & + + rxt(k,127)*y(k,98) + rxt(k,230)*y(k,126) + rxt(k,257)*y(k,127) & + + rxt(k,240)*y(k,128) + rxt(k,217)*y(k,129) + rxt(k,244) & + *y(k,131) + rxt(k,126)*y(k,132) + .920_r8*rxt(k,302)*y(k,133) & + + rxt(k,277)*y(k,134) + rxt(k,286)*y(k,135) + rxt(k,265) & + *y(k,138) + rxt(k,269)*y(k,139) + rxt(k,312)*y(k,140) + mat(k,1214) = mat(k,1214) + 1.206_r8*rxt(k,298)*y(k,72) + 2.000_r8*rxt(k,122) & + *y(k,88) + rxt(k,123)*y(k,97) + rxt(k,307)*y(k,102) + rxt(k,315) & + *y(k,122) + rxt(k,121)*y(k,132) + rxt(k,303)*y(k,133) & + + rxt(k,276)*y(k,134) + rxt(k,287)*y(k,135) + rxt(k,124) & + *y(k,137) + rxt(k,313)*y(k,140) + mat(k,198) = rxt(k,263)*y(k,137) + mat(k,890) = mat(k,890) + rxt(k,128)*y(k,88) + rxt(k,123)*y(k,90) + mat(k,1012) = mat(k,1012) + rxt(k,127)*y(k,88) + mat(k,472) = rxt(k,307)*y(k,90) + .400_r8*rxt(k,308)*y(k,137) + mat(k,315) = rxt(k,315)*y(k,90) + mat(k,374) = rxt(k,230)*y(k,88) + mat(k,396) = rxt(k,257)*y(k,88) + mat(k,702) = mat(k,702) + rxt(k,240)*y(k,88) + mat(k,761) = rxt(k,217)*y(k,88) + mat(k,332) = rxt(k,244)*y(k,88) + mat(k,946) = mat(k,946) + .206_r8*rxt(k,296)*y(k,72) + rxt(k,126)*y(k,88) & + + rxt(k,121)*y(k,90) + mat(k,636) = .920_r8*rxt(k,302)*y(k,88) + rxt(k,303)*y(k,90) + mat(k,656) = rxt(k,277)*y(k,88) + rxt(k,276)*y(k,90) + mat(k,675) = mat(k,675) + rxt(k,286)*y(k,88) + rxt(k,287)*y(k,90) + mat(k,1170) = mat(k,1170) + rxt(k,112)*y(k,66) + rxt(k,124)*y(k,90) & + + rxt(k,263)*y(k,91) + .400_r8*rxt(k,308)*y(k,102) + mat(k,347) = rxt(k,265)*y(k,88) + mat(k,499) = rxt(k,269)*y(k,88) + mat(k,585) = rxt(k,312)*y(k,88) + rxt(k,313)*y(k,90) + mat(k,1217) = -(rxt(k,121)*y(k,132) + rxt(k,122)*y(k,88) + rxt(k,123)*y(k,97) & + + rxt(k,124)*y(k,137) + rxt(k,132)*y(k,89) + rxt(k,211)*y(k,25) & + + rxt(k,235)*y(k,28) + rxt(k,253)*y(k,13) + rxt(k,260)*y(k,31) & + + rxt(k,276)*y(k,134) + rxt(k,287)*y(k,135) + rxt(k,295)*y(k,71) & + + rxt(k,298)*y(k,72) + rxt(k,303)*y(k,133) + rxt(k,307)*y(k,102) & + + rxt(k,313)*y(k,140) + rxt(k,315)*y(k,122) + rxt(k,318)*y(k,46)) + mat(k,949) = -rxt(k,121)*y(k,90) + mat(k,1284) = -rxt(k,122)*y(k,90) + mat(k,893) = -rxt(k,123)*y(k,90) + mat(k,1173) = -rxt(k,124)*y(k,90) + mat(k,1051) = -rxt(k,132)*y(k,90) + mat(k,794) = -rxt(k,211)*y(k,90) + mat(k,557) = -rxt(k,235)*y(k,90) + mat(k,545) = -rxt(k,253)*y(k,90) + mat(k,597) = -rxt(k,260)*y(k,90) + mat(k,658) = -rxt(k,276)*y(k,90) + mat(k,677) = -rxt(k,287)*y(k,90) + mat(k,443) = -rxt(k,295)*y(k,90) + mat(k,385) = -rxt(k,298)*y(k,90) + mat(k,638) = -rxt(k,303)*y(k,90) + mat(k,474) = -rxt(k,307)*y(k,90) + mat(k,587) = -rxt(k,313)*y(k,90) + mat(k,317) = -rxt(k,315)*y(k,90) + mat(k,141) = -rxt(k,318)*y(k,90) + mat(k,275) = rxt(k,183)*y(k,97) + mat(k,864) = rxt(k,150)*y(k,42) + mat(k,454) = rxt(k,150)*y(k,38) + rxt(k,152)*y(k,97) + rxt(k,153)*y(k,137) + mat(k,419) = rxt(k,134)*y(k,137) + mat(k,291) = .500_r8*rxt(k,288)*y(k,137) + mat(k,1051) = mat(k,1051) + rxt(k,120)*y(k,97) + rxt(k,119)*y(k,98) + mat(k,893) = mat(k,893) + rxt(k,183)*y(k,7) + rxt(k,152)*y(k,42) + rxt(k,120) & + *y(k,89) + mat(k,1015) = rxt(k,119)*y(k,89) + mat(k,259) = rxt(k,249)*y(k,137) + mat(k,1173) = mat(k,1173) + rxt(k,153)*y(k,42) + rxt(k,134)*y(k,65) & + + .500_r8*rxt(k,288)*y(k,76) + rxt(k,249)*y(k,103) + mat(k,194) = -(rxt(k,263)*y(k,137)) + mat(k,1112) = -rxt(k,263)*y(k,91) + mat(k,522) = rxt(k,253)*y(k,90) + mat(k,1180) = rxt(k,253)*y(k,13) + mat(k,886) = -(rxt(k,92)*y(k,98) + 4._r8*rxt(k,93)*y(k,97) + rxt(k,95) & + *y(k,55) + rxt(k,96)*y(k,57) + rxt(k,101)*y(k,132) + rxt(k,107) & + *y(k,137) + (rxt(k,118) + rxt(k,120)) * y(k,89) + rxt(k,123) & + *y(k,90) + rxt(k,128)*y(k,88) + rxt(k,152)*y(k,42) + rxt(k,154) & + *y(k,41) + rxt(k,157)*y(k,63) + rxt(k,160)*y(k,68) + rxt(k,183) & + *y(k,7) + rxt(k,184)*y(k,6) + rxt(k,186)*y(k,59) + rxt(k,188) & + *y(k,67) + rxt(k,212)*y(k,25) + rxt(k,320)*y(k,101)) + mat(k,1008) = -rxt(k,92)*y(k,97) + mat(k,518) = -rxt(k,95)*y(k,97) + mat(k,279) = -rxt(k,96)*y(k,97) + mat(k,942) = -rxt(k,101)*y(k,97) + mat(k,1166) = -rxt(k,107)*y(k,97) + mat(k,1044) = -(rxt(k,118) + rxt(k,120)) * y(k,97) + mat(k,1210) = -rxt(k,123)*y(k,97) + mat(k,1277) = -rxt(k,128)*y(k,97) + mat(k,451) = -rxt(k,152)*y(k,97) + mat(k,1235) = -rxt(k,154)*y(k,97) + mat(k,822) = -rxt(k,157)*y(k,97) + mat(k,404) = -rxt(k,160)*y(k,97) + mat(k,272) = -rxt(k,183)*y(k,97) + mat(k,964) = -rxt(k,184)*y(k,97) + mat(k,411) = -rxt(k,186)*y(k,97) + mat(k,356) = -rxt(k,188)*y(k,97) + mat(k,787) = -rxt(k,212)*y(k,97) + mat(k,166) = -rxt(k,320)*y(k,97) + mat(k,772) = rxt(k,99)*y(k,132) + mat(k,215) = rxt(k,113)*y(k,88) + rxt(k,114)*y(k,89) + mat(k,1277) = mat(k,1277) + rxt(k,113)*y(k,78) + mat(k,1044) = mat(k,1044) + rxt(k,114)*y(k,78) + mat(k,1008) = mat(k,1008) + .765_r8*rxt(k,316)*y(k,122) + 2.000_r8*rxt(k,91) & + *y(k,136) + mat(k,313) = .765_r8*rxt(k,316)*y(k,98) + mat(k,942) = mat(k,942) + rxt(k,99)*y(k,54) + mat(k,1081) = 2.000_r8*rxt(k,91)*y(k,98) + mat(k,1166) = mat(k,1166) + 2.000_r8*rxt(k,109)*y(k,137) + mat(k,1011) = -((rxt(k,90) + rxt(k,91)) * y(k,136) + rxt(k,92)*y(k,97) & + + rxt(k,102)*y(k,132) + rxt(k,103)*y(k,54) + rxt(k,108)*y(k,137) & + + rxt(k,119)*y(k,89) + rxt(k,127)*y(k,88) + rxt(k,143)*y(k,38) & + + rxt(k,175)*y(k,4) + rxt(k,226)*y(k,9) + rxt(k,254)*y(k,13) & + + rxt(k,279)*y(k,74) + rxt(k,289)*y(k,77) + rxt(k,304)*y(k,71) & + + rxt(k,316)*y(k,122) + rxt(k,324)*y(k,108) + rxt(k,330) & + *y(k,110)) + mat(k,1084) = -(rxt(k,90) + rxt(k,91)) * y(k,98) + mat(k,889) = -rxt(k,92)*y(k,98) + mat(k,945) = -rxt(k,102)*y(k,98) + mat(k,774) = -rxt(k,103)*y(k,98) + mat(k,1169) = -rxt(k,108)*y(k,98) + mat(k,1047) = -rxt(k,119)*y(k,98) + mat(k,1280) = -rxt(k,127)*y(k,98) + mat(k,860) = -rxt(k,143)*y(k,98) + mat(k,806) = -rxt(k,175)*y(k,98) + mat(k,225) = -rxt(k,226)*y(k,98) + mat(k,541) = -rxt(k,254)*y(k,98) + mat(k,568) = -rxt(k,279)*y(k,98) + mat(k,723) = -rxt(k,289)*y(k,98) + mat(k,440) = -rxt(k,304)*y(k,98) + mat(k,314) = -rxt(k,316)*y(k,98) + mat(k,238) = -rxt(k,324)*y(k,98) + mat(k,609) = -rxt(k,330)*y(k,98) + mat(k,701) = .150_r8*rxt(k,239)*y(k,132) + mat(k,945) = mat(k,945) + .150_r8*rxt(k,239)*y(k,128) + .150_r8*rxt(k,284) & + *y(k,135) + mat(k,674) = .150_r8*rxt(k,284)*y(k,132) + mat(k,152) = -(rxt(k,331)*y(k,110)) + mat(k,599) = -rxt(k,331)*y(k,100) + mat(k,954) = rxt(k,177)*y(k,41) + mat(k,1224) = rxt(k,177)*y(k,6) + 2.000_r8*rxt(k,147)*y(k,41) + mat(k,160) = -(rxt(k,320)*y(k,97) + rxt(k,321)*y(k,137)) + mat(k,868) = -rxt(k,320)*y(k,101) + mat(k,1107) = -rxt(k,321)*y(k,101) + mat(k,467) = -(rxt(k,307)*y(k,90) + rxt(k,308)*y(k,137)) + mat(k,1189) = -rxt(k,307)*y(k,102) + mat(k,1143) = -rxt(k,308)*y(k,102) + mat(k,378) = .794_r8*rxt(k,297)*y(k,88) + .794_r8*rxt(k,298)*y(k,90) & + + .794_r8*rxt(k,296)*y(k,132) + mat(k,1258) = .794_r8*rxt(k,297)*y(k,72) + .080_r8*rxt(k,302)*y(k,133) & + + .800_r8*rxt(k,278)*y(k,134) + mat(k,1189) = mat(k,1189) + .794_r8*rxt(k,298)*y(k,72) + mat(k,922) = .794_r8*rxt(k,296)*y(k,72) + mat(k,620) = .080_r8*rxt(k,302)*y(k,88) + mat(k,644) = .800_r8*rxt(k,278)*y(k,88) + end do + end subroutine nlnmat04 + subroutine nlnmat05( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,252) = -(rxt(k,249)*y(k,137)) + mat(k,1121) = -rxt(k,249)*y(k,103) + mat(k,1023) = rxt(k,251)*y(k,128) + mat(k,681) = rxt(k,251)*y(k,89) + mat(k,260) = -(rxt(k,266)*y(k,137)) + mat(k,1122) = -rxt(k,266)*y(k,106) + mat(k,907) = rxt(k,264)*y(k,138) + mat(k,341) = rxt(k,264)*y(k,132) + mat(k,206) = -(rxt(k,270)*y(k,137)) + mat(k,1114) = -rxt(k,270)*y(k,107) + mat(k,905) = .850_r8*rxt(k,268)*y(k,139) + mat(k,490) = .850_r8*rxt(k,268)*y(k,132) + mat(k,234) = -(rxt(k,324)*y(k,98) + rxt(k,327)*y(k,137)) + mat(k,976) = -rxt(k,324)*y(k,108) + mat(k,1118) = -rxt(k,327)*y(k,108) + mat(k,602) = -(rxt(k,325)*y(k,6) + rxt(k,326)*y(k,41) + rxt(k,328)*y(k,89) & + + rxt(k,330)*y(k,98) + rxt(k,331)*y(k,100) + rxt(k,332)*y(k,137)) + mat(k,959) = -rxt(k,325)*y(k,110) + mat(k,1228) = -rxt(k,326)*y(k,110) + mat(k,1034) = -rxt(k,328)*y(k,110) + mat(k,996) = -rxt(k,330)*y(k,110) + mat(k,154) = -rxt(k,331)*y(k,110) + mat(k,1154) = -rxt(k,332)*y(k,110) + mat(k,880) = rxt(k,320)*y(k,101) + mat(k,996) = mat(k,996) + rxt(k,324)*y(k,108) + mat(k,164) = rxt(k,320)*y(k,97) + mat(k,235) = rxt(k,324)*y(k,98) + rxt(k,327)*y(k,137) + mat(k,1154) = mat(k,1154) + rxt(k,327)*y(k,108) + mat(k,422) = -(rxt(k,323)*y(k,137)) + mat(k,1139) = -rxt(k,323)*y(k,111) + mat(k,958) = rxt(k,325)*y(k,110) + mat(k,1226) = rxt(k,326)*y(k,110) + mat(k,138) = rxt(k,318)*y(k,90) + (rxt(k,319)+.500_r8*rxt(k,333))*y(k,137) + mat(k,1029) = rxt(k,328)*y(k,110) + mat(k,1186) = rxt(k,318)*y(k,46) + mat(k,982) = rxt(k,330)*y(k,110) + mat(k,153) = rxt(k,331)*y(k,110) + mat(k,162) = rxt(k,321)*y(k,137) + mat(k,601) = rxt(k,325)*y(k,6) + rxt(k,326)*y(k,41) + rxt(k,328)*y(k,89) & + + rxt(k,330)*y(k,98) + rxt(k,331)*y(k,100) + rxt(k,332)*y(k,137) + mat(k,1139) = mat(k,1139) + (rxt(k,319)+.500_r8*rxt(k,333))*y(k,46) & + + rxt(k,321)*y(k,101) + rxt(k,332)*y(k,110) + mat(k,116) = -(rxt(k,334)*y(k,141)) + mat(k,1289) = -rxt(k,334)*y(k,112) + mat(k,421) = rxt(k,323)*y(k,137) + mat(k,1101) = rxt(k,323)*y(k,111) + mat(k,308) = -(rxt(k,315)*y(k,90) + rxt(k,316)*y(k,98) + rxt(k,317)*y(k,137)) + mat(k,1181) = -rxt(k,315)*y(k,122) + mat(k,977) = -rxt(k,316)*y(k,122) + mat(k,1127) = -rxt(k,317)*y(k,122) + mat(k,100) = -(rxt(k,314)*y(k,137)) + mat(k,1098) = -rxt(k,314)*y(k,123) + mat(k,898) = rxt(k,311)*y(k,140) + mat(k,571) = rxt(k,311)*y(k,132) + mat(k,369) = -(4._r8*rxt(k,227)*y(k,126) + rxt(k,228)*y(k,129) + rxt(k,229) & + *y(k,132) + rxt(k,230)*y(k,88)) + mat(k,738) = -rxt(k,228)*y(k,126) + mat(k,916) = -rxt(k,229)*y(k,126) + mat(k,1254) = -rxt(k,230)*y(k,126) + mat(k,148) = .500_r8*rxt(k,232)*y(k,137) + mat(k,131) = rxt(k,233)*y(k,38) + rxt(k,234)*y(k,137) + mat(k,841) = rxt(k,233)*y(k,12) + mat(k,1134) = .500_r8*rxt(k,232)*y(k,11) + rxt(k,234)*y(k,12) + mat(k,389) = -(rxt(k,255)*y(k,129) + rxt(k,256)*y(k,132) + rxt(k,257)*y(k,88)) + mat(k,739) = -rxt(k,255)*y(k,127) + mat(k,918) = -rxt(k,256)*y(k,127) + mat(k,1256) = -rxt(k,257)*y(k,127) + mat(k,40) = 1.670_r8*rxt(k,293)*y(k,137) + mat(k,190) = rxt(k,258)*y(k,137) + mat(k,70) = rxt(k,259)*y(k,137) + mat(k,1135) = 1.670_r8*rxt(k,293)*y(k,3) + rxt(k,258)*y(k,14) + rxt(k,259) & + *y(k,15) + mat(k,695) = -(4._r8*rxt(k,237)*y(k,128) + rxt(k,238)*y(k,129) + rxt(k,239) & + *y(k,132) + rxt(k,240)*y(k,88) + rxt(k,251)*y(k,89) + rxt(k,273) & + *y(k,134) + rxt(k,299)*y(k,133) + rxt(k,309)*y(k,140)) + mat(k,751) = -rxt(k,238)*y(k,128) + mat(k,934) = -rxt(k,239)*y(k,128) + mat(k,1269) = -rxt(k,240)*y(k,128) + mat(k,1036) = -rxt(k,251)*y(k,128) + mat(k,651) = -rxt(k,273)*y(k,128) + mat(k,629) = -rxt(k,299)*y(k,128) + mat(k,580) = -rxt(k,309)*y(k,128) + mat(k,551) = rxt(k,235)*y(k,90) + rxt(k,236)*y(k,137) + mat(k,592) = rxt(k,260)*y(k,90) + rxt(k,261)*y(k,137) + mat(k,303) = .500_r8*rxt(k,242)*y(k,137) + mat(k,435) = .080_r8*rxt(k,304)*y(k,98) + mat(k,564) = .100_r8*rxt(k,279)*y(k,98) + mat(k,714) = .280_r8*rxt(k,289)*y(k,98) + mat(k,1269) = mat(k,1269) + .530_r8*rxt(k,277)*y(k,134) + rxt(k,286)*y(k,135) & + + rxt(k,269)*y(k,139) + mat(k,1202) = rxt(k,235)*y(k,28) + rxt(k,260)*y(k,31) + .530_r8*rxt(k,276) & + *y(k,134) + rxt(k,287)*y(k,135) + mat(k,1000) = .080_r8*rxt(k,304)*y(k,71) + .100_r8*rxt(k,279)*y(k,74) & + + .280_r8*rxt(k,289)*y(k,77) + mat(k,695) = mat(k,695) + .530_r8*rxt(k,273)*y(k,134) + mat(k,751) = mat(k,751) + .260_r8*rxt(k,274)*y(k,134) + rxt(k,283)*y(k,135) & + + .300_r8*rxt(k,267)*y(k,139) + mat(k,934) = mat(k,934) + .450_r8*rxt(k,284)*y(k,135) + .150_r8*rxt(k,268) & + *y(k,139) + mat(k,651) = mat(k,651) + .530_r8*rxt(k,277)*y(k,88) + .530_r8*rxt(k,276) & + *y(k,90) + .530_r8*rxt(k,273)*y(k,128) + .260_r8*rxt(k,274) & + *y(k,129) + mat(k,669) = rxt(k,286)*y(k,88) + rxt(k,287)*y(k,90) + rxt(k,283)*y(k,129) & + + .450_r8*rxt(k,284)*y(k,132) + 4.000_r8*rxt(k,285)*y(k,135) + mat(k,1158) = rxt(k,236)*y(k,28) + rxt(k,261)*y(k,31) + .500_r8*rxt(k,242) & + *y(k,33) + mat(k,495) = rxt(k,269)*y(k,88) + .300_r8*rxt(k,267)*y(k,129) & + + .150_r8*rxt(k,268)*y(k,132) + mat(k,753) = -(rxt(k,144)*y(k,41) + (4._r8*rxt(k,214) + 4._r8*rxt(k,215) & + ) * y(k,129) + rxt(k,216)*y(k,132) + rxt(k,217)*y(k,88) & + + rxt(k,228)*y(k,126) + rxt(k,238)*y(k,128) + rxt(k,255) & + *y(k,127) + rxt(k,267)*y(k,139) + rxt(k,274)*y(k,134) + rxt(k,283) & + *y(k,135) + rxt(k,300)*y(k,133) + rxt(k,310)*y(k,140)) + mat(k,1229) = -rxt(k,144)*y(k,129) + mat(k,936) = -rxt(k,216)*y(k,129) + mat(k,1271) = -rxt(k,217)*y(k,129) + mat(k,371) = -rxt(k,228)*y(k,129) + mat(k,697) = -rxt(k,238)*y(k,129) + mat(k,393) = -rxt(k,255)*y(k,129) + mat(k,496) = -rxt(k,267)*y(k,129) + mat(k,652) = -rxt(k,274)*y(k,129) + mat(k,670) = -rxt(k,283)*y(k,129) + mat(k,631) = -rxt(k,300)*y(k,129) + mat(k,581) = -rxt(k,310)*y(k,129) + mat(k,534) = .280_r8*rxt(k,254)*y(k,98) + mat(k,320) = rxt(k,241)*y(k,137) + mat(k,201) = .700_r8*rxt(k,219)*y(k,137) + mat(k,480) = rxt(k,138)*y(k,38) + rxt(k,221)*y(k,136) + rxt(k,220)*y(k,137) + mat(k,851) = rxt(k,138)*y(k,36) + mat(k,437) = .050_r8*rxt(k,304)*y(k,98) + mat(k,1271) = mat(k,1271) + rxt(k,240)*y(k,128) + mat(k,1002) = .280_r8*rxt(k,254)*y(k,13) + .050_r8*rxt(k,304)*y(k,71) + mat(k,697) = mat(k,697) + rxt(k,240)*y(k,88) + 4.000_r8*rxt(k,237)*y(k,128) & + + .900_r8*rxt(k,238)*y(k,129) + .450_r8*rxt(k,239)*y(k,132) & + + rxt(k,299)*y(k,133) + rxt(k,273)*y(k,134) + rxt(k,282) & + *y(k,135) + rxt(k,309)*y(k,140) + mat(k,753) = mat(k,753) + .900_r8*rxt(k,238)*y(k,128) + mat(k,936) = mat(k,936) + .450_r8*rxt(k,239)*y(k,128) + mat(k,631) = mat(k,631) + rxt(k,299)*y(k,128) + mat(k,652) = mat(k,652) + rxt(k,273)*y(k,128) + mat(k,670) = mat(k,670) + rxt(k,282)*y(k,128) + mat(k,1075) = rxt(k,221)*y(k,36) + mat(k,1160) = rxt(k,241)*y(k,32) + .700_r8*rxt(k,219)*y(k,35) + rxt(k,220) & + *y(k,36) + mat(k,581) = mat(k,581) + rxt(k,309)*y(k,128) + mat(k,1246) = .750_r8*rxt(k,244)*y(k,131) + mat(k,327) = .750_r8*rxt(k,244)*y(k,88) + mat(k,328) = -(rxt(k,243)*y(k,132) + rxt(k,244)*y(k,88)) + mat(k,912) = -rxt(k,243)*y(k,131) + mat(k,1250) = -rxt(k,244)*y(k,131) + mat(k,221) = rxt(k,250)*y(k,137) + mat(k,1130) = rxt(k,250)*y(k,9) + mat(k,943) = -((rxt(k,97) + rxt(k,98) + rxt(k,99)) * y(k,54) + rxt(k,101) & + *y(k,97) + rxt(k,102)*y(k,98) + rxt(k,106)*y(k,137) & + + 4._r8*rxt(k,111)*y(k,132) + rxt(k,121)*y(k,90) + rxt(k,126) & + *y(k,88) + rxt(k,131)*y(k,89) + (rxt(k,141) + rxt(k,142) & + ) * y(k,38) + rxt(k,148)*y(k,41) + rxt(k,174)*y(k,4) + rxt(k,180) & + *y(k,6) + rxt(k,216)*y(k,129) + rxt(k,229)*y(k,126) + rxt(k,239) & + *y(k,128) + rxt(k,243)*y(k,131) + rxt(k,256)*y(k,127) + rxt(k,264) & + *y(k,138) + rxt(k,268)*y(k,139) + rxt(k,275)*y(k,134) + rxt(k,284) & + *y(k,135) + rxt(k,296)*y(k,72) + rxt(k,301)*y(k,133) + rxt(k,311) & + *y(k,140)) + mat(k,773) = -(rxt(k,97) + rxt(k,98) + rxt(k,99)) * y(k,132) + mat(k,887) = -rxt(k,101)*y(k,132) + mat(k,1009) = -rxt(k,102)*y(k,132) + mat(k,1167) = -rxt(k,106)*y(k,132) + mat(k,1211) = -rxt(k,121)*y(k,132) + mat(k,1278) = -rxt(k,126)*y(k,132) + mat(k,1045) = -rxt(k,131)*y(k,132) + mat(k,858) = -(rxt(k,141) + rxt(k,142)) * y(k,132) + mat(k,1236) = -rxt(k,148)*y(k,132) + mat(k,804) = -rxt(k,174)*y(k,132) + mat(k,965) = -rxt(k,180)*y(k,132) + mat(k,759) = -rxt(k,216)*y(k,132) + mat(k,373) = -rxt(k,229)*y(k,132) + mat(k,700) = -rxt(k,239)*y(k,132) + mat(k,331) = -rxt(k,243)*y(k,132) + mat(k,395) = -rxt(k,256)*y(k,132) + mat(k,346) = -rxt(k,264)*y(k,132) + mat(k,498) = -rxt(k,268)*y(k,132) + mat(k,655) = -rxt(k,275)*y(k,132) + mat(k,673) = -rxt(k,284)*y(k,132) + mat(k,382) = -rxt(k,296)*y(k,132) + mat(k,634) = -rxt(k,301)*y(k,132) + mat(k,584) = -rxt(k,311)*y(k,132) + mat(k,804) = mat(k,804) + rxt(k,173)*y(k,25) + mat(k,965) = mat(k,965) + rxt(k,185)*y(k,137) + mat(k,224) = .130_r8*rxt(k,226)*y(k,98) + mat(k,113) = rxt(k,231)*y(k,137) + mat(k,540) = .280_r8*rxt(k,254)*y(k,98) + mat(k,788) = rxt(k,173)*y(k,4) + rxt(k,137)*y(k,38) + rxt(k,211)*y(k,90) & + + rxt(k,212)*y(k,97) + mat(k,297) = rxt(k,196)*y(k,38) + rxt(k,197)*y(k,137) + mat(k,173) = rxt(k,199)*y(k,38) + rxt(k,200)*y(k,137) + mat(k,250) = rxt(k,218)*y(k,137) + mat(k,486) = rxt(k,222)*y(k,136) + mat(k,858) = mat(k,858) + rxt(k,137)*y(k,25) + rxt(k,196)*y(k,26) & + + rxt(k,199)*y(k,29) + rxt(k,140)*y(k,57) + mat(k,1236) = mat(k,1236) + rxt(k,144)*y(k,129) + rxt(k,155)*y(k,137) + mat(k,512) = rxt(k,224)*y(k,137) + mat(k,139) = .500_r8*rxt(k,333)*y(k,137) + mat(k,463) = rxt(k,247)*y(k,137) + mat(k,339) = rxt(k,248)*y(k,137) + mat(k,280) = rxt(k,140)*y(k,38) + rxt(k,96)*y(k,97) + rxt(k,105)*y(k,137) + mat(k,507) = rxt(k,262)*y(k,137) + mat(k,439) = .370_r8*rxt(k,304)*y(k,98) + mat(k,382) = mat(k,382) + .794_r8*rxt(k,297)*y(k,88) + .794_r8*rxt(k,298) & + *y(k,90) + mat(k,567) = .140_r8*rxt(k,279)*y(k,98) + mat(k,145) = .200_r8*rxt(k,281)*y(k,137) + mat(k,288) = .500_r8*rxt(k,288)*y(k,137) + mat(k,722) = .280_r8*rxt(k,289)*y(k,98) + mat(k,1278) = mat(k,1278) + .794_r8*rxt(k,297)*y(k,72) + rxt(k,230)*y(k,126) & + + rxt(k,257)*y(k,127) + rxt(k,217)*y(k,129) + .250_r8*rxt(k,244) & + *y(k,131) + .920_r8*rxt(k,302)*y(k,133) + .470_r8*rxt(k,277) & + *y(k,134) + rxt(k,265)*y(k,138) + rxt(k,312)*y(k,140) + mat(k,1211) = mat(k,1211) + rxt(k,211)*y(k,25) + .794_r8*rxt(k,298)*y(k,72) & + + rxt(k,307)*y(k,102) + rxt(k,303)*y(k,133) + .470_r8*rxt(k,276) & + *y(k,134) + rxt(k,124)*y(k,137) + rxt(k,313)*y(k,140) + mat(k,887) = mat(k,887) + rxt(k,212)*y(k,25) + rxt(k,96)*y(k,57) + mat(k,1009) = mat(k,1009) + .130_r8*rxt(k,226)*y(k,9) + .280_r8*rxt(k,254) & + *y(k,13) + .370_r8*rxt(k,304)*y(k,71) + .140_r8*rxt(k,279) & + *y(k,74) + .280_r8*rxt(k,289)*y(k,77) + rxt(k,108)*y(k,137) + mat(k,471) = rxt(k,307)*y(k,90) + rxt(k,308)*y(k,137) + mat(k,425) = rxt(k,323)*y(k,137) + mat(k,373) = mat(k,373) + rxt(k,230)*y(k,88) + 2.400_r8*rxt(k,227)*y(k,126) & + + rxt(k,228)*y(k,129) + mat(k,395) = mat(k,395) + rxt(k,257)*y(k,88) + rxt(k,255)*y(k,129) + mat(k,700) = mat(k,700) + .900_r8*rxt(k,238)*y(k,129) + rxt(k,299)*y(k,133) & + + .470_r8*rxt(k,273)*y(k,134) + rxt(k,309)*y(k,140) + mat(k,759) = mat(k,759) + rxt(k,144)*y(k,41) + rxt(k,217)*y(k,88) & + + rxt(k,228)*y(k,126) + rxt(k,255)*y(k,127) + .900_r8*rxt(k,238) & + *y(k,128) + 4.000_r8*rxt(k,214)*y(k,129) + rxt(k,300)*y(k,133) & + + .730_r8*rxt(k,274)*y(k,134) + rxt(k,283)*y(k,135) & + + .300_r8*rxt(k,267)*y(k,139) + .800_r8*rxt(k,310)*y(k,140) + mat(k,331) = mat(k,331) + .250_r8*rxt(k,244)*y(k,88) + mat(k,634) = mat(k,634) + .920_r8*rxt(k,302)*y(k,88) + rxt(k,303)*y(k,90) & + + rxt(k,299)*y(k,128) + rxt(k,300)*y(k,129) + mat(k,655) = mat(k,655) + .470_r8*rxt(k,277)*y(k,88) + .470_r8*rxt(k,276) & + *y(k,90) + .470_r8*rxt(k,273)*y(k,128) + .730_r8*rxt(k,274) & + *y(k,129) + mat(k,673) = mat(k,673) + rxt(k,283)*y(k,129) + mat(k,1082) = rxt(k,222)*y(k,36) + mat(k,1167) = mat(k,1167) + rxt(k,185)*y(k,6) + rxt(k,231)*y(k,10) & + + rxt(k,197)*y(k,26) + rxt(k,200)*y(k,29) + rxt(k,218)*y(k,34) & + + rxt(k,155)*y(k,41) + rxt(k,224)*y(k,44) + .500_r8*rxt(k,333) & + *y(k,46) + rxt(k,247)*y(k,52) + rxt(k,248)*y(k,53) + rxt(k,105) & + *y(k,57) + rxt(k,262)*y(k,69) + .200_r8*rxt(k,281)*y(k,75) & + + .500_r8*rxt(k,288)*y(k,76) + rxt(k,124)*y(k,90) + rxt(k,108) & + *y(k,98) + rxt(k,308)*y(k,102) + rxt(k,323)*y(k,111) + mat(k,346) = mat(k,346) + rxt(k,265)*y(k,88) + mat(k,498) = mat(k,498) + .300_r8*rxt(k,267)*y(k,129) + mat(k,584) = mat(k,584) + rxt(k,312)*y(k,88) + rxt(k,313)*y(k,90) & + + rxt(k,309)*y(k,128) + .800_r8*rxt(k,310)*y(k,129) + end do + end subroutine nlnmat05 + subroutine nlnmat06( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,626) = -(rxt(k,299)*y(k,128) + rxt(k,300)*y(k,129) + rxt(k,301) & + *y(k,132) + rxt(k,302)*y(k,88) + rxt(k,303)*y(k,90)) + mat(k,692) = -rxt(k,299)*y(k,133) + mat(k,748) = -rxt(k,300)*y(k,133) + mat(k,931) = -rxt(k,301)*y(k,133) + mat(k,1266) = -rxt(k,302)*y(k,133) + mat(k,1199) = -rxt(k,303)*y(k,133) + mat(k,434) = rxt(k,305)*y(k,137) + mat(k,243) = .200_r8*rxt(k,306)*y(k,137) + mat(k,1199) = mat(k,1199) + 1.700_r8*rxt(k,315)*y(k,122) + mat(k,311) = 1.700_r8*rxt(k,315)*y(k,90) + 1.640_r8*rxt(k,317)*y(k,137) + mat(k,1155) = rxt(k,305)*y(k,71) + .200_r8*rxt(k,306)*y(k,73) & + + 1.640_r8*rxt(k,317)*y(k,122) + mat(k,649) = -(rxt(k,273)*y(k,128) + rxt(k,274)*y(k,129) + rxt(k,275) & + *y(k,132) + rxt(k,276)*y(k,90) + (rxt(k,277) + rxt(k,278) & + ) * y(k,88)) + mat(k,693) = -rxt(k,273)*y(k,134) + mat(k,749) = -rxt(k,274)*y(k,134) + mat(k,932) = -rxt(k,275)*y(k,134) + mat(k,1200) = -rxt(k,276)*y(k,134) + mat(k,1267) = -(rxt(k,277) + rxt(k,278)) * y(k,134) + mat(k,562) = .500_r8*rxt(k,280)*y(k,137) + mat(k,143) = .200_r8*rxt(k,281)*y(k,137) + mat(k,712) = rxt(k,290)*y(k,137) + mat(k,1156) = .500_r8*rxt(k,280)*y(k,74) + .200_r8*rxt(k,281)*y(k,75) & + + rxt(k,290)*y(k,77) + mat(k,668) = -(rxt(k,282)*y(k,128) + rxt(k,283)*y(k,129) + rxt(k,284) & + *y(k,132) + 4._r8*rxt(k,285)*y(k,135) + rxt(k,286)*y(k,88) & + + rxt(k,287)*y(k,90) + rxt(k,291)*y(k,89)) + mat(k,694) = -rxt(k,282)*y(k,135) + mat(k,750) = -rxt(k,283)*y(k,135) + mat(k,933) = -rxt(k,284)*y(k,135) + mat(k,1268) = -rxt(k,286)*y(k,135) + mat(k,1201) = -rxt(k,287)*y(k,135) + mat(k,1035) = -rxt(k,291)*y(k,135) + mat(k,563) = .500_r8*rxt(k,280)*y(k,137) + mat(k,144) = .500_r8*rxt(k,281)*y(k,137) + mat(k,1157) = .500_r8*rxt(k,280)*y(k,74) + .500_r8*rxt(k,281)*y(k,75) + mat(k,1086) = -(rxt(k,86)*y(k,55) + rxt(k,87)*y(k,141) + (rxt(k,90) + rxt(k,91) & + ) * y(k,98) + (rxt(k,129) + rxt(k,130)) * y(k,79) + rxt(k,162) & + *y(k,16) + rxt(k,163)*y(k,17) + rxt(k,164)*y(k,19) + rxt(k,165) & + *y(k,20) + rxt(k,166)*y(k,21) + rxt(k,167)*y(k,22) + rxt(k,168) & + *y(k,23) + (rxt(k,169) + rxt(k,170)) * y(k,63) + rxt(k,189) & + *y(k,18) + rxt(k,190)*y(k,37) + rxt(k,191)*y(k,56) + (rxt(k,192) & + + rxt(k,193)) * y(k,59) + rxt(k,206)*y(k,24) + rxt(k,207) & + *y(k,26) + rxt(k,208)*y(k,60) + rxt(k,209)*y(k,61) + rxt(k,210) & + *y(k,62) + (rxt(k,221) + rxt(k,222) + rxt(k,223)) * y(k,36)) + mat(k,519) = -rxt(k,86)*y(k,136) + mat(k,1302) = -rxt(k,87)*y(k,136) + mat(k,1013) = -(rxt(k,90) + rxt(k,91)) * y(k,136) + mat(k,98) = -(rxt(k,129) + rxt(k,130)) * y(k,136) + mat(k,50) = -rxt(k,162)*y(k,136) + mat(k,76) = -rxt(k,163)*y(k,136) + mat(k,56) = -rxt(k,164)*y(k,136) + mat(k,59) = -rxt(k,165)*y(k,136) + mat(k,62) = -rxt(k,166)*y(k,136) + mat(k,65) = -rxt(k,167)*y(k,136) + mat(k,68) = -rxt(k,168)*y(k,136) + mat(k,827) = -(rxt(k,169) + rxt(k,170)) * y(k,136) + mat(k,53) = -rxt(k,189)*y(k,136) + mat(k,186) = -rxt(k,190)*y(k,136) + mat(k,44) = -rxt(k,191)*y(k,136) + mat(k,413) = -(rxt(k,192) + rxt(k,193)) * y(k,136) + mat(k,231) = -rxt(k,206)*y(k,136) + mat(k,298) = -rxt(k,207)*y(k,136) + mat(k,91) = -rxt(k,208)*y(k,136) + mat(k,95) = -rxt(k,209)*y(k,136) + mat(k,105) = -rxt(k,210)*y(k,136) + mat(k,487) = -(rxt(k,221) + rxt(k,222) + rxt(k,223)) * y(k,136) + mat(k,1172) = -(rxt(k,104)*y(k,55) + rxt(k,105)*y(k,57) + rxt(k,106)*y(k,132) & + + rxt(k,107)*y(k,97) + rxt(k,108)*y(k,98) + (4._r8*rxt(k,109) & + + 4._r8*rxt(k,110)) * y(k,137) + rxt(k,112)*y(k,66) + rxt(k,124) & + *y(k,90) + rxt(k,125)*y(k,78) + rxt(k,133)*y(k,89) + rxt(k,134) & + *y(k,65) + rxt(k,153)*y(k,42) + (rxt(k,155) + rxt(k,156) & + ) * y(k,41) + rxt(k,158)*y(k,63) + rxt(k,161)*y(k,68) + rxt(k,185) & + *y(k,6) + rxt(k,187)*y(k,59) + rxt(k,195)*y(k,24) + rxt(k,197) & + *y(k,26) + rxt(k,198)*y(k,27) + rxt(k,200)*y(k,29) + rxt(k,202) & + *y(k,37) + rxt(k,203)*y(k,60) + rxt(k,204)*y(k,61) + rxt(k,205) & + *y(k,62) + rxt(k,213)*y(k,25) + rxt(k,218)*y(k,34) + rxt(k,219) & + *y(k,35) + rxt(k,220)*y(k,36) + rxt(k,224)*y(k,44) + rxt(k,231) & + *y(k,10) + rxt(k,232)*y(k,11) + rxt(k,234)*y(k,12) + rxt(k,236) & + *y(k,28) + rxt(k,241)*y(k,32) + rxt(k,242)*y(k,33) + rxt(k,247) & + *y(k,52) + rxt(k,248)*y(k,53) + rxt(k,249)*y(k,103) + rxt(k,250) & + *y(k,9) + rxt(k,258)*y(k,14) + rxt(k,259)*y(k,15) + rxt(k,261) & + *y(k,31) + rxt(k,262)*y(k,69) + rxt(k,263)*y(k,91) + rxt(k,266) & + *y(k,106) + rxt(k,270)*y(k,107) + rxt(k,271)*y(k,13) + rxt(k,272) & + *y(k,30) + rxt(k,280)*y(k,74) + rxt(k,281)*y(k,75) + rxt(k,288) & + *y(k,76) + rxt(k,290)*y(k,77) + rxt(k,293)*y(k,3) + rxt(k,294) & + *y(k,70) + rxt(k,305)*y(k,71) + rxt(k,306)*y(k,73) + rxt(k,308) & + *y(k,102) + rxt(k,314)*y(k,123) + rxt(k,317)*y(k,122) + (rxt(k,319) & + + rxt(k,333)) * y(k,46) + rxt(k,321)*y(k,101) + rxt(k,323) & + *y(k,111) + rxt(k,327)*y(k,108) + rxt(k,332)*y(k,110) + rxt(k,335) & + *y(k,84)) + mat(k,520) = -rxt(k,104)*y(k,137) + mat(k,281) = -rxt(k,105)*y(k,137) + mat(k,948) = -rxt(k,106)*y(k,137) + mat(k,892) = -rxt(k,107)*y(k,137) + mat(k,1014) = -rxt(k,108)*y(k,137) + mat(k,179) = -rxt(k,112)*y(k,137) + mat(k,1216) = -rxt(k,124)*y(k,137) + mat(k,218) = -rxt(k,125)*y(k,137) + mat(k,1050) = -rxt(k,133)*y(k,137) + mat(k,418) = -rxt(k,134)*y(k,137) + mat(k,453) = -rxt(k,153)*y(k,137) + mat(k,1241) = -(rxt(k,155) + rxt(k,156)) * y(k,137) + mat(k,828) = -rxt(k,158)*y(k,137) + mat(k,405) = -rxt(k,161)*y(k,137) + mat(k,970) = -rxt(k,185)*y(k,137) + mat(k,414) = -rxt(k,187)*y(k,137) + mat(k,232) = -rxt(k,195)*y(k,137) + mat(k,299) = -rxt(k,197)*y(k,137) + mat(k,79) = -rxt(k,198)*y(k,137) + mat(k,174) = -rxt(k,200)*y(k,137) + mat(k,187) = -rxt(k,202)*y(k,137) + mat(k,92) = -rxt(k,203)*y(k,137) + mat(k,96) = -rxt(k,204)*y(k,137) + mat(k,106) = -rxt(k,205)*y(k,137) + mat(k,793) = -rxt(k,213)*y(k,137) + mat(k,251) = -rxt(k,218)*y(k,137) + mat(k,204) = -rxt(k,219)*y(k,137) + mat(k,488) = -rxt(k,220)*y(k,137) + mat(k,513) = -rxt(k,224)*y(k,137) + mat(k,114) = -rxt(k,231)*y(k,137) + mat(k,151) = -rxt(k,232)*y(k,137) + mat(k,134) = -rxt(k,234)*y(k,137) + mat(k,556) = -rxt(k,236)*y(k,137) + mat(k,321) = -rxt(k,241)*y(k,137) + mat(k,306) = -rxt(k,242)*y(k,137) + mat(k,464) = -rxt(k,247)*y(k,137) + mat(k,340) = -rxt(k,248)*y(k,137) + mat(k,258) = -rxt(k,249)*y(k,137) + mat(k,226) = -rxt(k,250)*y(k,137) + mat(k,192) = -rxt(k,258)*y(k,137) + mat(k,71) = -rxt(k,259)*y(k,137) + mat(k,596) = -rxt(k,261)*y(k,137) + mat(k,508) = -rxt(k,262)*y(k,137) + mat(k,199) = -rxt(k,263)*y(k,137) + mat(k,266) = -rxt(k,266)*y(k,137) + mat(k,210) = -rxt(k,270)*y(k,137) + mat(k,544) = -rxt(k,271)*y(k,137) + mat(k,364) = -rxt(k,272)*y(k,137) + mat(k,569) = -rxt(k,280)*y(k,137) + mat(k,146) = -rxt(k,281)*y(k,137) + mat(k,290) = -rxt(k,288)*y(k,137) + mat(k,726) = -rxt(k,290)*y(k,137) + mat(k,41) = -rxt(k,293)*y(k,137) + mat(k,159) = -rxt(k,294)*y(k,137) + mat(k,442) = -rxt(k,305)*y(k,137) + mat(k,247) = -rxt(k,306)*y(k,137) + mat(k,473) = -rxt(k,308)*y(k,137) + mat(k,102) = -rxt(k,314)*y(k,137) + mat(k,316) = -rxt(k,317)*y(k,137) + mat(k,140) = -(rxt(k,319) + rxt(k,333)) * y(k,137) + mat(k,167) = -rxt(k,321)*y(k,137) + mat(k,426) = -rxt(k,323)*y(k,137) + mat(k,239) = -rxt(k,327)*y(k,137) + mat(k,611) = -rxt(k,332)*y(k,137) + mat(k,46) = -rxt(k,335)*y(k,137) + mat(k,226) = mat(k,226) + .130_r8*rxt(k,226)*y(k,98) + mat(k,151) = mat(k,151) + .500_r8*rxt(k,232)*y(k,137) + mat(k,544) = mat(k,544) + .360_r8*rxt(k,254)*y(k,98) + mat(k,793) = mat(k,793) + rxt(k,212)*y(k,97) + mat(k,204) = mat(k,204) + .300_r8*rxt(k,219)*y(k,137) + mat(k,488) = mat(k,488) + rxt(k,221)*y(k,136) + mat(k,863) = rxt(k,142)*y(k,132) + mat(k,776) = rxt(k,103)*y(k,98) + 2.000_r8*rxt(k,98)*y(k,132) + mat(k,520) = mat(k,520) + rxt(k,95)*y(k,97) + rxt(k,86)*y(k,136) + mat(k,281) = mat(k,281) + rxt(k,96)*y(k,97) + mat(k,414) = mat(k,414) + rxt(k,186)*y(k,97) + rxt(k,192)*y(k,136) + mat(k,828) = mat(k,828) + rxt(k,157)*y(k,97) + rxt(k,169)*y(k,136) + mat(k,358) = rxt(k,188)*y(k,97) + mat(k,405) = mat(k,405) + rxt(k,160)*y(k,97) + mat(k,442) = mat(k,442) + .320_r8*rxt(k,304)*y(k,98) + mat(k,384) = .206_r8*rxt(k,296)*y(k,132) + mat(k,569) = mat(k,569) + .240_r8*rxt(k,279)*y(k,98) + mat(k,146) = mat(k,146) + .100_r8*rxt(k,281)*y(k,137) + mat(k,726) = mat(k,726) + .360_r8*rxt(k,289)*y(k,98) + mat(k,1283) = rxt(k,126)*y(k,132) + mat(k,1216) = mat(k,1216) + rxt(k,121)*y(k,132) + mat(k,892) = mat(k,892) + rxt(k,212)*y(k,25) + rxt(k,95)*y(k,55) + rxt(k,96) & + *y(k,57) + rxt(k,186)*y(k,59) + rxt(k,157)*y(k,63) + rxt(k,188) & + *y(k,67) + rxt(k,160)*y(k,68) + rxt(k,101)*y(k,132) + mat(k,1014) = mat(k,1014) + .130_r8*rxt(k,226)*y(k,9) + .360_r8*rxt(k,254) & + *y(k,13) + rxt(k,103)*y(k,54) + .320_r8*rxt(k,304)*y(k,71) & + + .240_r8*rxt(k,279)*y(k,74) + .360_r8*rxt(k,289)*y(k,77) & + + 1.156_r8*rxt(k,316)*y(k,122) + rxt(k,102)*y(k,132) + mat(k,266) = mat(k,266) + .500_r8*rxt(k,266)*y(k,137) + mat(k,316) = mat(k,316) + 1.156_r8*rxt(k,316)*y(k,98) + mat(k,102) = mat(k,102) + .500_r8*rxt(k,314)*y(k,137) + mat(k,703) = .450_r8*rxt(k,239)*y(k,132) + mat(k,948) = mat(k,948) + rxt(k,142)*y(k,38) + 2.000_r8*rxt(k,98)*y(k,54) & + + .206_r8*rxt(k,296)*y(k,72) + rxt(k,126)*y(k,88) + rxt(k,121) & + *y(k,90) + rxt(k,101)*y(k,97) + rxt(k,102)*y(k,98) & + + .450_r8*rxt(k,239)*y(k,128) + .450_r8*rxt(k,284)*y(k,135) & + + .150_r8*rxt(k,268)*y(k,139) + mat(k,676) = .450_r8*rxt(k,284)*y(k,132) + mat(k,1087) = rxt(k,221)*y(k,36) + rxt(k,86)*y(k,55) + rxt(k,192)*y(k,59) & + + rxt(k,169)*y(k,63) + 2.000_r8*rxt(k,87)*y(k,141) + mat(k,1172) = mat(k,1172) + .500_r8*rxt(k,232)*y(k,11) + .300_r8*rxt(k,219) & + *y(k,35) + .100_r8*rxt(k,281)*y(k,75) + .500_r8*rxt(k,266) & + *y(k,106) + .500_r8*rxt(k,314)*y(k,123) + mat(k,500) = .150_r8*rxt(k,268)*y(k,132) + mat(k,1303) = 2.000_r8*rxt(k,87)*y(k,136) + end do + end subroutine nlnmat06 + subroutine nlnmat07( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,342) = -(rxt(k,264)*y(k,132) + rxt(k,265)*y(k,88)) + mat(k,913) = -rxt(k,264)*y(k,138) + mat(k,1252) = -rxt(k,265)*y(k,138) + mat(k,525) = rxt(k,271)*y(k,137) + mat(k,261) = .500_r8*rxt(k,266)*y(k,137) + mat(k,1132) = rxt(k,271)*y(k,13) + .500_r8*rxt(k,266)*y(k,106) + mat(k,492) = -(rxt(k,267)*y(k,129) + rxt(k,268)*y(k,132) + rxt(k,269)*y(k,88)) + mat(k,741) = -rxt(k,267)*y(k,139) + mat(k,923) = -rxt(k,268)*y(k,139) + mat(k,1259) = -rxt(k,269)*y(k,139) + mat(k,361) = rxt(k,272)*y(k,137) + mat(k,207) = rxt(k,270)*y(k,137) + mat(k,1145) = rxt(k,272)*y(k,30) + rxt(k,270)*y(k,107) + mat(k,578) = -(rxt(k,309)*y(k,128) + rxt(k,310)*y(k,129) + rxt(k,311) & + *y(k,132) + rxt(k,312)*y(k,88) + rxt(k,313)*y(k,90)) + mat(k,690) = -rxt(k,309)*y(k,140) + mat(k,746) = -rxt(k,310)*y(k,140) + mat(k,929) = -rxt(k,311)*y(k,140) + mat(k,1264) = -rxt(k,312)*y(k,140) + mat(k,1196) = -rxt(k,313)*y(k,140) + mat(k,158) = rxt(k,294)*y(k,137) + mat(k,242) = .800_r8*rxt(k,306)*y(k,137) + mat(k,101) = .500_r8*rxt(k,314)*y(k,137) + mat(k,1152) = rxt(k,294)*y(k,70) + .800_r8*rxt(k,306)*y(k,73) & + + .500_r8*rxt(k,314)*y(k,123) + mat(k,1307) = -(rxt(k,87)*y(k,136) + rxt(k,334)*y(k,112)) + mat(k,1091) = -rxt(k,87)*y(k,141) + mat(k,119) = -rxt(k,334)*y(k,141) + mat(k,135) = rxt(k,234)*y(k,137) + mat(k,193) = rxt(k,258)*y(k,137) + mat(k,72) = rxt(k,259)*y(k,137) + mat(k,233) = rxt(k,195)*y(k,137) + mat(k,795) = rxt(k,213)*y(k,137) + mat(k,300) = rxt(k,197)*y(k,137) + mat(k,80) = rxt(k,198)*y(k,137) + mat(k,558) = rxt(k,236)*y(k,137) + mat(k,175) = rxt(k,200)*y(k,137) + mat(k,365) = rxt(k,272)*y(k,137) + mat(k,598) = rxt(k,261)*y(k,137) + mat(k,322) = rxt(k,241)*y(k,137) + mat(k,307) = rxt(k,242)*y(k,137) + mat(k,205) = rxt(k,219)*y(k,137) + mat(k,489) = rxt(k,220)*y(k,137) + mat(k,777) = rxt(k,99)*y(k,132) + mat(k,521) = rxt(k,104)*y(k,137) + mat(k,282) = rxt(k,105)*y(k,137) + mat(k,415) = rxt(k,187)*y(k,137) + mat(k,107) = rxt(k,205)*y(k,137) + mat(k,831) = (rxt(k,351)+rxt(k,356))*y(k,67) + (rxt(k,344)+rxt(k,350) & + +rxt(k,355))*y(k,68) + rxt(k,158)*y(k,137) + mat(k,420) = rxt(k,134)*y(k,137) + mat(k,181) = rxt(k,112)*y(k,137) + mat(k,359) = (rxt(k,351)+rxt(k,356))*y(k,63) + mat(k,407) = (rxt(k,344)+rxt(k,350)+rxt(k,355))*y(k,63) + rxt(k,161)*y(k,137) + mat(k,570) = .500_r8*rxt(k,280)*y(k,137) + mat(k,47) = rxt(k,335)*y(k,137) + mat(k,267) = rxt(k,266)*y(k,137) + mat(k,211) = rxt(k,270)*y(k,137) + mat(k,952) = rxt(k,99)*y(k,54) + rxt(k,106)*y(k,137) + mat(k,1176) = rxt(k,234)*y(k,12) + rxt(k,258)*y(k,14) + rxt(k,259)*y(k,15) & + + rxt(k,195)*y(k,24) + rxt(k,213)*y(k,25) + rxt(k,197)*y(k,26) & + + rxt(k,198)*y(k,27) + rxt(k,236)*y(k,28) + rxt(k,200)*y(k,29) & + + rxt(k,272)*y(k,30) + rxt(k,261)*y(k,31) + rxt(k,241)*y(k,32) & + + rxt(k,242)*y(k,33) + rxt(k,219)*y(k,35) + rxt(k,220)*y(k,36) & + + rxt(k,104)*y(k,55) + rxt(k,105)*y(k,57) + rxt(k,187)*y(k,59) & + + rxt(k,205)*y(k,62) + rxt(k,158)*y(k,63) + rxt(k,134)*y(k,65) & + + rxt(k,112)*y(k,66) + rxt(k,161)*y(k,68) + .500_r8*rxt(k,280) & + *y(k,74) + rxt(k,335)*y(k,84) + rxt(k,266)*y(k,106) + rxt(k,270) & + *y(k,107) + rxt(k,106)*y(k,132) + 2.000_r8*rxt(k,109)*y(k,137) + end do + end subroutine nlnmat07 + subroutine nlnmat_finit( avec_len, mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: dti(veclen) + real(r8), intent(in) :: lmat(veclen,nzcnt) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k, 1) = lmat(k, 1) + mat(k, 2) = lmat(k, 2) + mat(k, 3) = lmat(k, 3) + mat(k, 4) = lmat(k, 4) + mat(k, 5) = lmat(k, 5) + mat(k, 6) = lmat(k, 6) + mat(k, 7) = lmat(k, 7) + mat(k, 8) = lmat(k, 8) + mat(k, 9) = lmat(k, 9) + mat(k, 10) = lmat(k, 10) + mat(k, 11) = lmat(k, 11) + mat(k, 12) = lmat(k, 12) + mat(k, 13) = lmat(k, 13) + mat(k, 14) = lmat(k, 14) + mat(k, 15) = lmat(k, 15) + mat(k, 16) = lmat(k, 16) + mat(k, 17) = lmat(k, 17) + mat(k, 18) = lmat(k, 18) + mat(k, 19) = lmat(k, 19) + mat(k, 20) = lmat(k, 20) + mat(k, 21) = lmat(k, 21) + mat(k, 22) = lmat(k, 22) + mat(k, 23) = lmat(k, 23) + mat(k, 24) = lmat(k, 24) + mat(k, 25) = lmat(k, 25) + mat(k, 26) = lmat(k, 26) + mat(k, 27) = lmat(k, 27) + mat(k, 28) = lmat(k, 28) + mat(k, 29) = lmat(k, 29) + mat(k, 30) = lmat(k, 30) + mat(k, 31) = lmat(k, 31) + mat(k, 32) = lmat(k, 32) + mat(k, 33) = lmat(k, 33) + mat(k, 34) = lmat(k, 34) + mat(k, 35) = lmat(k, 35) + mat(k, 36) = lmat(k, 36) + mat(k, 37) = lmat(k, 37) + mat(k, 38) = lmat(k, 38) + mat(k, 39) = mat(k, 39) + lmat(k, 39) + mat(k, 42) = mat(k, 42) + lmat(k, 42) + mat(k, 43) = mat(k, 43) + lmat(k, 43) + mat(k, 45) = mat(k, 45) + lmat(k, 45) + mat(k, 48) = mat(k, 48) + lmat(k, 48) + mat(k, 49) = mat(k, 49) + lmat(k, 49) + mat(k, 51) = mat(k, 51) + lmat(k, 51) + mat(k, 52) = mat(k, 52) + lmat(k, 52) + mat(k, 54) = mat(k, 54) + lmat(k, 54) + mat(k, 55) = mat(k, 55) + lmat(k, 55) + mat(k, 57) = mat(k, 57) + lmat(k, 57) + mat(k, 58) = mat(k, 58) + lmat(k, 58) + mat(k, 60) = mat(k, 60) + lmat(k, 60) + mat(k, 61) = mat(k, 61) + lmat(k, 61) + mat(k, 63) = mat(k, 63) + lmat(k, 63) + mat(k, 64) = mat(k, 64) + lmat(k, 64) + mat(k, 66) = mat(k, 66) + lmat(k, 66) + mat(k, 67) = mat(k, 67) + lmat(k, 67) + mat(k, 69) = mat(k, 69) + lmat(k, 69) + mat(k, 73) = mat(k, 73) + lmat(k, 73) + mat(k, 74) = mat(k, 74) + lmat(k, 74) + mat(k, 75) = mat(k, 75) + lmat(k, 75) + mat(k, 77) = mat(k, 77) + lmat(k, 77) + mat(k, 78) = mat(k, 78) + lmat(k, 78) + mat(k, 81) = lmat(k, 81) + mat(k, 82) = lmat(k, 82) + mat(k, 83) = lmat(k, 83) + mat(k, 84) = lmat(k, 84) + mat(k, 85) = lmat(k, 85) + mat(k, 86) = lmat(k, 86) + mat(k, 87) = lmat(k, 87) + mat(k, 88) = lmat(k, 88) + mat(k, 89) = mat(k, 89) + lmat(k, 89) + mat(k, 90) = mat(k, 90) + lmat(k, 90) + mat(k, 93) = mat(k, 93) + lmat(k, 93) + mat(k, 94) = mat(k, 94) + lmat(k, 94) + mat(k, 97) = mat(k, 97) + lmat(k, 97) + mat(k, 98) = mat(k, 98) + lmat(k, 98) + mat(k, 100) = mat(k, 100) + lmat(k, 100) + mat(k, 102) = mat(k, 102) + lmat(k, 102) + mat(k, 103) = mat(k, 103) + lmat(k, 103) + mat(k, 104) = mat(k, 104) + lmat(k, 104) + mat(k, 108) = lmat(k, 108) + mat(k, 109) = lmat(k, 109) + mat(k, 110) = lmat(k, 110) + mat(k, 111) = mat(k, 111) + lmat(k, 111) + mat(k, 116) = mat(k, 116) + lmat(k, 116) + mat(k, 117) = lmat(k, 117) + mat(k, 118) = lmat(k, 118) + mat(k, 120) = lmat(k, 120) + mat(k, 121) = lmat(k, 121) + mat(k, 122) = lmat(k, 122) + mat(k, 123) = lmat(k, 123) + mat(k, 124) = lmat(k, 124) + mat(k, 125) = lmat(k, 125) + mat(k, 126) = lmat(k, 126) + mat(k, 127) = lmat(k, 127) + mat(k, 128) = lmat(k, 128) + mat(k, 129) = lmat(k, 129) + mat(k, 130) = mat(k, 130) + lmat(k, 130) + mat(k, 136) = mat(k, 136) + lmat(k, 136) + mat(k, 142) = mat(k, 142) + lmat(k, 142) + mat(k, 147) = mat(k, 147) + lmat(k, 147) + mat(k, 149) = mat(k, 149) + lmat(k, 149) + mat(k, 150) = lmat(k, 150) + mat(k, 151) = mat(k, 151) + lmat(k, 151) + mat(k, 152) = mat(k, 152) + lmat(k, 152) + mat(k, 155) = lmat(k, 155) + mat(k, 156) = mat(k, 156) + lmat(k, 156) + mat(k, 157) = mat(k, 157) + lmat(k, 157) + mat(k, 160) = mat(k, 160) + lmat(k, 160) + mat(k, 161) = lmat(k, 161) + mat(k, 163) = mat(k, 163) + lmat(k, 163) + mat(k, 168) = mat(k, 168) + lmat(k, 168) + mat(k, 170) = lmat(k, 170) + mat(k, 172) = mat(k, 172) + lmat(k, 172) + mat(k, 176) = mat(k, 176) + lmat(k, 176) + mat(k, 177) = lmat(k, 177) + mat(k, 178) = mat(k, 178) + lmat(k, 178) + mat(k, 179) = mat(k, 179) + lmat(k, 179) + mat(k, 180) = lmat(k, 180) + mat(k, 182) = mat(k, 182) + lmat(k, 182) + mat(k, 183) = mat(k, 183) + lmat(k, 183) + mat(k, 188) = mat(k, 188) + lmat(k, 188) + mat(k, 189) = lmat(k, 189) + mat(k, 191) = lmat(k, 191) + mat(k, 192) = mat(k, 192) + lmat(k, 192) + mat(k, 194) = mat(k, 194) + lmat(k, 194) + mat(k, 196) = lmat(k, 196) + mat(k, 197) = lmat(k, 197) + mat(k, 198) = mat(k, 198) + lmat(k, 198) + mat(k, 200) = mat(k, 200) + lmat(k, 200) + mat(k, 202) = lmat(k, 202) + mat(k, 203) = mat(k, 203) + lmat(k, 203) + mat(k, 204) = mat(k, 204) + lmat(k, 204) + mat(k, 206) = mat(k, 206) + lmat(k, 206) + mat(k, 208) = lmat(k, 208) + mat(k, 209) = lmat(k, 209) + mat(k, 210) = mat(k, 210) + lmat(k, 210) + mat(k, 213) = mat(k, 213) + lmat(k, 213) + mat(k, 215) = mat(k, 215) + lmat(k, 215) + mat(k, 219) = mat(k, 219) + lmat(k, 219) + mat(k, 220) = mat(k, 220) + lmat(k, 220) + mat(k, 227) = mat(k, 227) + lmat(k, 227) + mat(k, 228) = mat(k, 228) + lmat(k, 228) + mat(k, 234) = mat(k, 234) + lmat(k, 234) + mat(k, 235) = mat(k, 235) + lmat(k, 235) + mat(k, 237) = lmat(k, 237) + mat(k, 240) = mat(k, 240) + lmat(k, 240) + mat(k, 241) = lmat(k, 241) + mat(k, 244) = lmat(k, 244) + mat(k, 245) = lmat(k, 245) + mat(k, 246) = lmat(k, 246) + mat(k, 248) = mat(k, 248) + lmat(k, 248) + mat(k, 252) = mat(k, 252) + lmat(k, 252) + mat(k, 253) = lmat(k, 253) + mat(k, 254) = lmat(k, 254) + mat(k, 255) = lmat(k, 255) + mat(k, 257) = lmat(k, 257) + mat(k, 259) = mat(k, 259) + lmat(k, 259) + mat(k, 260) = mat(k, 260) + lmat(k, 260) + mat(k, 263) = lmat(k, 263) + mat(k, 264) = lmat(k, 264) + mat(k, 265) = lmat(k, 265) + mat(k, 266) = mat(k, 266) + lmat(k, 266) + mat(k, 268) = mat(k, 268) + lmat(k, 268) + mat(k, 269) = lmat(k, 269) + mat(k, 270) = lmat(k, 270) + mat(k, 271) = lmat(k, 271) + mat(k, 273) = mat(k, 273) + lmat(k, 273) + mat(k, 274) = lmat(k, 274) + mat(k, 275) = mat(k, 275) + lmat(k, 275) + mat(k, 276) = mat(k, 276) + lmat(k, 276) + mat(k, 281) = mat(k, 281) + lmat(k, 281) + mat(k, 283) = mat(k, 283) + lmat(k, 283) + mat(k, 286) = lmat(k, 286) + mat(k, 289) = lmat(k, 289) + mat(k, 292) = mat(k, 292) + lmat(k, 292) + mat(k, 293) = lmat(k, 293) + mat(k, 294) = mat(k, 294) + lmat(k, 294) + mat(k, 301) = mat(k, 301) + lmat(k, 301) + mat(k, 302) = mat(k, 302) + lmat(k, 302) + mat(k, 304) = lmat(k, 304) + mat(k, 306) = mat(k, 306) + lmat(k, 306) + mat(k, 308) = mat(k, 308) + lmat(k, 308) + mat(k, 318) = mat(k, 318) + lmat(k, 318) + mat(k, 323) = lmat(k, 323) + mat(k, 324) = lmat(k, 324) + mat(k, 325) = lmat(k, 325) + mat(k, 328) = mat(k, 328) + lmat(k, 328) + mat(k, 336) = mat(k, 336) + lmat(k, 336) + mat(k, 337) = mat(k, 337) + lmat(k, 337) + mat(k, 339) = mat(k, 339) + lmat(k, 339) + mat(k, 342) = mat(k, 342) + lmat(k, 342) + mat(k, 352) = mat(k, 352) + lmat(k, 352) + mat(k, 353) = lmat(k, 353) + mat(k, 358) = mat(k, 358) + lmat(k, 358) + mat(k, 360) = mat(k, 360) + lmat(k, 360) + mat(k, 362) = lmat(k, 362) + mat(k, 363) = lmat(k, 363) + mat(k, 369) = mat(k, 369) + lmat(k, 369) + mat(k, 377) = mat(k, 377) + lmat(k, 377) + mat(k, 389) = mat(k, 389) + lmat(k, 389) + mat(k, 401) = mat(k, 401) + lmat(k, 401) + mat(k, 403) = mat(k, 403) + lmat(k, 403) + mat(k, 405) = mat(k, 405) + lmat(k, 405) + mat(k, 408) = mat(k, 408) + lmat(k, 408) + mat(k, 409) = mat(k, 409) + lmat(k, 409) + mat(k, 410) = mat(k, 410) + lmat(k, 410) + mat(k, 416) = mat(k, 416) + lmat(k, 416) + mat(k, 417) = lmat(k, 417) + mat(k, 418) = mat(k, 418) + lmat(k, 418) + mat(k, 422) = mat(k, 422) + lmat(k, 422) + mat(k, 423) = lmat(k, 423) + mat(k, 424) = lmat(k, 424) + mat(k, 429) = mat(k, 429) + lmat(k, 429) + mat(k, 446) = mat(k, 446) + lmat(k, 446) + mat(k, 447) = mat(k, 447) + lmat(k, 447) + mat(k, 448) = mat(k, 448) + lmat(k, 448) + mat(k, 450) = mat(k, 450) + lmat(k, 450) + mat(k, 452) = lmat(k, 452) + mat(k, 454) = mat(k, 454) + lmat(k, 454) + mat(k, 455) = mat(k, 455) + lmat(k, 455) + mat(k, 459) = mat(k, 459) + lmat(k, 459) + mat(k, 460) = lmat(k, 460) + mat(k, 461) = mat(k, 461) + lmat(k, 461) + mat(k, 463) = mat(k, 463) + lmat(k, 463) + mat(k, 466) = lmat(k, 466) + mat(k, 467) = mat(k, 467) + lmat(k, 467) + mat(k, 468) = lmat(k, 468) + mat(k, 470) = lmat(k, 470) + mat(k, 471) = mat(k, 471) + lmat(k, 471) + mat(k, 472) = mat(k, 472) + lmat(k, 472) + mat(k, 476) = lmat(k, 476) + mat(k, 477) = mat(k, 477) + lmat(k, 477) + mat(k, 478) = lmat(k, 478) + mat(k, 479) = mat(k, 479) + lmat(k, 479) + mat(k, 480) = mat(k, 480) + lmat(k, 480) + mat(k, 481) = mat(k, 481) + lmat(k, 481) + mat(k, 482) = mat(k, 482) + lmat(k, 482) + mat(k, 485) = lmat(k, 485) + mat(k, 488) = mat(k, 488) + lmat(k, 488) + mat(k, 489) = mat(k, 489) + lmat(k, 489) + mat(k, 492) = mat(k, 492) + lmat(k, 492) + mat(k, 503) = mat(k, 503) + lmat(k, 503) + mat(k, 505) = lmat(k, 505) + mat(k, 506) = lmat(k, 506) + mat(k, 507) = mat(k, 507) + lmat(k, 507) + mat(k, 510) = mat(k, 510) + lmat(k, 510) + mat(k, 514) = mat(k, 514) + lmat(k, 514) + mat(k, 530) = mat(k, 530) + lmat(k, 530) + mat(k, 549) = lmat(k, 549) + mat(k, 550) = mat(k, 550) + lmat(k, 550) + mat(k, 552) = lmat(k, 552) + mat(k, 554) = lmat(k, 554) + mat(k, 559) = mat(k, 559) + lmat(k, 559) + mat(k, 560) = mat(k, 560) + lmat(k, 560) + mat(k, 563) = mat(k, 563) + lmat(k, 563) + mat(k, 564) = mat(k, 564) + lmat(k, 564) + mat(k, 565) = mat(k, 565) + lmat(k, 565) + mat(k, 567) = mat(k, 567) + lmat(k, 567) + mat(k, 578) = mat(k, 578) + lmat(k, 578) + mat(k, 590) = mat(k, 590) + lmat(k, 590) + mat(k, 591) = mat(k, 591) + lmat(k, 591) + mat(k, 592) = mat(k, 592) + lmat(k, 592) + mat(k, 594) = lmat(k, 594) + mat(k, 600) = lmat(k, 600) + mat(k, 601) = mat(k, 601) + lmat(k, 601) + mat(k, 602) = mat(k, 602) + lmat(k, 602) + mat(k, 606) = lmat(k, 606) + mat(k, 626) = mat(k, 626) + lmat(k, 626) + mat(k, 649) = mat(k, 649) + lmat(k, 649) + mat(k, 668) = mat(k, 668) + lmat(k, 668) + mat(k, 695) = mat(k, 695) + lmat(k, 695) + mat(k, 708) = mat(k, 708) + lmat(k, 708) + mat(k, 709) = lmat(k, 709) + mat(k, 714) = mat(k, 714) + lmat(k, 714) + mat(k, 715) = mat(k, 715) + lmat(k, 715) + mat(k, 716) = lmat(k, 716) + mat(k, 753) = mat(k, 753) + lmat(k, 753) + mat(k, 769) = mat(k, 769) + lmat(k, 769) + mat(k, 773) = mat(k, 773) + lmat(k, 773) + mat(k, 780) = mat(k, 780) + lmat(k, 780) + mat(k, 781) = lmat(k, 781) + mat(k, 782) = mat(k, 782) + lmat(k, 782) + mat(k, 783) = mat(k, 783) + lmat(k, 783) + mat(k, 800) = mat(k, 800) + lmat(k, 800) + mat(k, 818) = mat(k, 818) + lmat(k, 818) + mat(k, 820) = mat(k, 820) + lmat(k, 820) + mat(k, 821) = mat(k, 821) + lmat(k, 821) + mat(k, 856) = mat(k, 856) + lmat(k, 856) + mat(k, 886) = mat(k, 886) + lmat(k, 886) + mat(k, 889) = mat(k, 889) + lmat(k, 889) + mat(k, 943) = mat(k, 943) + lmat(k, 943) + mat(k, 952) = mat(k, 952) + lmat(k, 952) + mat(k, 961) = mat(k, 961) + lmat(k, 961) + mat(k, 964) = mat(k, 964) + lmat(k, 964) + mat(k, 966) = mat(k, 966) + lmat(k, 966) + mat(k,1008) = mat(k,1008) + lmat(k,1008) + mat(k,1011) = mat(k,1011) + lmat(k,1011) + mat(k,1013) = mat(k,1013) + lmat(k,1013) + mat(k,1028) = mat(k,1028) + lmat(k,1028) + mat(k,1044) = mat(k,1044) + lmat(k,1044) + mat(k,1048) = mat(k,1048) + lmat(k,1048) + mat(k,1050) = mat(k,1050) + lmat(k,1050) + mat(k,1053) = mat(k,1053) + lmat(k,1053) + mat(k,1081) = mat(k,1081) + lmat(k,1081) + mat(k,1086) = mat(k,1086) + lmat(k,1086) + mat(k,1172) = mat(k,1172) + lmat(k,1172) + mat(k,1185) = mat(k,1185) + lmat(k,1185) + mat(k,1210) = mat(k,1210) + lmat(k,1210) + mat(k,1214) = mat(k,1214) + lmat(k,1214) + mat(k,1217) = mat(k,1217) + lmat(k,1217) + mat(k,1219) = mat(k,1219) + lmat(k,1219) + mat(k,1234) = mat(k,1234) + lmat(k,1234) + mat(k,1235) = mat(k,1235) + lmat(k,1235) + mat(k,1243) = mat(k,1243) + lmat(k,1243) + mat(k,1248) = mat(k,1248) + lmat(k,1248) + mat(k,1277) = mat(k,1277) + lmat(k,1277) + mat(k,1286) = mat(k,1286) + lmat(k,1286) + mat(k,1291) = lmat(k,1291) + mat(k,1293) = lmat(k,1293) + mat(k,1297) = lmat(k,1297) + mat(k,1302) = mat(k,1302) + lmat(k,1302) + mat(k,1303) = mat(k,1303) + lmat(k,1303) + mat(k,1307) = mat(k,1307) + lmat(k,1307) + mat(k, 217) = 0._r8 + mat(k, 329) = 0._r8 + mat(k, 333) = 0._r8 + mat(k, 338) = 0._r8 + mat(k, 343) = 0._r8 + mat(k, 348) = 0._r8 + mat(k, 350) = 0._r8 + mat(k, 355) = 0._r8 + mat(k, 375) = 0._r8 + mat(k, 390) = 0._r8 + mat(k, 392) = 0._r8 + mat(k, 397) = 0._r8 + mat(k, 399) = 0._r8 + mat(k, 427) = 0._r8 + mat(k, 430) = 0._r8 + mat(k, 441) = 0._r8 + mat(k, 444) = 0._r8 + mat(k, 456) = 0._r8 + mat(k, 462) = 0._r8 + mat(k, 469) = 0._r8 + mat(k, 475) = 0._r8 + mat(k, 502) = 0._r8 + mat(k, 511) = 0._r8 + mat(k, 527) = 0._r8 + mat(k, 529) = 0._r8 + mat(k, 532) = 0._r8 + mat(k, 533) = 0._r8 + mat(k, 535) = 0._r8 + mat(k, 537) = 0._r8 + mat(k, 538) = 0._r8 + mat(k, 539) = 0._r8 + mat(k, 542) = 0._r8 + mat(k, 543) = 0._r8 + mat(k, 546) = 0._r8 + mat(k, 547) = 0._r8 + mat(k, 553) = 0._r8 + mat(k, 555) = 0._r8 + mat(k, 566) = 0._r8 + mat(k, 583) = 0._r8 + mat(k, 586) = 0._r8 + mat(k, 593) = 0._r8 + mat(k, 595) = 0._r8 + mat(k, 607) = 0._r8 + mat(k, 614) = 0._r8 + mat(k, 622) = 0._r8 + mat(k, 624) = 0._r8 + mat(k, 627) = 0._r8 + mat(k, 628) = 0._r8 + mat(k, 633) = 0._r8 + mat(k, 635) = 0._r8 + mat(k, 637) = 0._r8 + mat(k, 640) = 0._r8 + mat(k, 647) = 0._r8 + mat(k, 650) = 0._r8 + mat(k, 654) = 0._r8 + mat(k, 657) = 0._r8 + mat(k, 660) = 0._r8 + mat(k, 665) = 0._r8 + mat(k, 666) = 0._r8 + mat(k, 667) = 0._r8 + mat(k, 672) = 0._r8 + mat(k, 679) = 0._r8 + mat(k, 699) = 0._r8 + mat(k, 704) = 0._r8 + mat(k, 706) = 0._r8 + mat(k, 713) = 0._r8 + mat(k, 717) = 0._r8 + mat(k, 719) = 0._r8 + mat(k, 720) = 0._r8 + mat(k, 721) = 0._r8 + mat(k, 724) = 0._r8 + mat(k, 725) = 0._r8 + mat(k, 727) = 0._r8 + mat(k, 728) = 0._r8 + mat(k, 729) = 0._r8 + mat(k, 754) = 0._r8 + mat(k, 756) = 0._r8 + mat(k, 758) = 0._r8 + mat(k, 760) = 0._r8 + mat(k, 762) = 0._r8 + mat(k, 763) = 0._r8 + mat(k, 764) = 0._r8 + mat(k, 767) = 0._r8 + mat(k, 770) = 0._r8 + mat(k, 771) = 0._r8 + mat(k, 775) = 0._r8 + mat(k, 789) = 0._r8 + mat(k, 790) = 0._r8 + mat(k, 791) = 0._r8 + mat(k, 792) = 0._r8 + mat(k, 798) = 0._r8 + mat(k, 801) = 0._r8 + mat(k, 802) = 0._r8 + mat(k, 803) = 0._r8 + mat(k, 807) = 0._r8 + mat(k, 808) = 0._r8 + mat(k, 809) = 0._r8 + mat(k, 810) = 0._r8 + mat(k, 811) = 0._r8 + mat(k, 819) = 0._r8 + mat(k, 823) = 0._r8 + mat(k, 824) = 0._r8 + mat(k, 825) = 0._r8 + mat(k, 826) = 0._r8 + mat(k, 829) = 0._r8 + mat(k, 840) = 0._r8 + mat(k, 844) = 0._r8 + mat(k, 848) = 0._r8 + mat(k, 849) = 0._r8 + mat(k, 850) = 0._r8 + mat(k, 857) = 0._r8 + mat(k, 859) = 0._r8 + mat(k, 861) = 0._r8 + mat(k, 862) = 0._r8 + mat(k, 866) = 0._r8 + mat(k, 867) = 0._r8 + mat(k, 869) = 0._r8 + mat(k, 875) = 0._r8 + mat(k, 876) = 0._r8 + mat(k, 891) = 0._r8 + mat(k, 896) = 0._r8 + mat(k, 899) = 0._r8 + mat(k, 915) = 0._r8 + mat(k, 921) = 0._r8 + mat(k, 924) = 0._r8 + mat(k, 925) = 0._r8 + mat(k, 927) = 0._r8 + mat(k, 930) = 0._r8 + mat(k, 947) = 0._r8 + mat(k, 957) = 0._r8 + mat(k, 960) = 0._r8 + mat(k, 962) = 0._r8 + mat(k, 967) = 0._r8 + mat(k, 969) = 0._r8 + mat(k, 971) = 0._r8 + mat(k, 974) = 0._r8 + mat(k, 980) = 0._r8 + mat(k, 981) = 0._r8 + mat(k, 984) = 0._r8 + mat(k, 985) = 0._r8 + mat(k, 987) = 0._r8 + mat(k, 988) = 0._r8 + mat(k, 990) = 0._r8 + mat(k, 994) = 0._r8 + mat(k, 997) = 0._r8 + mat(k, 998) = 0._r8 + mat(k, 999) = 0._r8 + mat(k,1006) = 0._r8 + mat(k,1018) = 0._r8 + mat(k,1026) = 0._r8 + mat(k,1027) = 0._r8 + mat(k,1031) = 0._r8 + mat(k,1032) = 0._r8 + mat(k,1033) = 0._r8 + mat(k,1037) = 0._r8 + mat(k,1038) = 0._r8 + mat(k,1039) = 0._r8 + mat(k,1040) = 0._r8 + mat(k,1041) = 0._r8 + mat(k,1042) = 0._r8 + mat(k,1043) = 0._r8 + mat(k,1049) = 0._r8 + mat(k,1054) = 0._r8 + mat(k,1073) = 0._r8 + mat(k,1085) = 0._r8 + mat(k,1088) = 0._r8 + mat(k,1171) = 0._r8 + mat(k,1183) = 0._r8 + mat(k,1190) = 0._r8 + mat(k,1198) = 0._r8 + mat(k,1204) = 0._r8 + mat(k,1205) = 0._r8 + mat(k,1207) = 0._r8 + mat(k,1208) = 0._r8 + mat(k,1209) = 0._r8 + mat(k,1212) = 0._r8 + mat(k,1213) = 0._r8 + mat(k,1215) = 0._r8 + mat(k,1218) = 0._r8 + mat(k,1220) = 0._r8 + mat(k,1230) = 0._r8 + mat(k,1238) = 0._r8 + mat(k,1240) = 0._r8 + mat(k,1242) = 0._r8 + mat(k,1245) = 0._r8 + mat(k,1272) = 0._r8 + mat(k,1275) = 0._r8 + mat(k,1282) = 0._r8 + mat(k,1287) = 0._r8 + mat(k,1290) = 0._r8 + mat(k,1292) = 0._r8 + mat(k,1294) = 0._r8 + mat(k,1295) = 0._r8 + mat(k,1296) = 0._r8 + mat(k,1298) = 0._r8 + mat(k,1299) = 0._r8 + mat(k,1300) = 0._r8 + mat(k,1301) = 0._r8 + mat(k,1304) = 0._r8 + mat(k,1305) = 0._r8 + mat(k,1306) = 0._r8 + mat(k, 1) = mat(k, 1) - dti(k) + mat(k, 2) = mat(k, 2) - dti(k) + mat(k, 3) = mat(k, 3) - dti(k) + mat(k, 4) = mat(k, 4) - dti(k) + mat(k, 5) = mat(k, 5) - dti(k) + mat(k, 6) = mat(k, 6) - dti(k) + mat(k, 7) = mat(k, 7) - dti(k) + mat(k, 8) = mat(k, 8) - dti(k) + mat(k, 9) = mat(k, 9) - dti(k) + mat(k, 11) = mat(k, 11) - dti(k) + mat(k, 12) = mat(k, 12) - dti(k) + mat(k, 13) = mat(k, 13) - dti(k) + mat(k, 14) = mat(k, 14) - dti(k) + mat(k, 15) = mat(k, 15) - dti(k) + mat(k, 16) = mat(k, 16) - dti(k) + mat(k, 17) = mat(k, 17) - dti(k) + mat(k, 18) = mat(k, 18) - dti(k) + mat(k, 19) = mat(k, 19) - dti(k) + mat(k, 20) = mat(k, 20) - dti(k) + mat(k, 21) = mat(k, 21) - dti(k) + mat(k, 22) = mat(k, 22) - dti(k) + mat(k, 23) = mat(k, 23) - dti(k) + mat(k, 24) = mat(k, 24) - dti(k) + mat(k, 25) = mat(k, 25) - dti(k) + mat(k, 26) = mat(k, 26) - dti(k) + mat(k, 27) = mat(k, 27) - dti(k) + mat(k, 28) = mat(k, 28) - dti(k) + mat(k, 29) = mat(k, 29) - dti(k) + mat(k, 30) = mat(k, 30) - dti(k) + mat(k, 31) = mat(k, 31) - dti(k) + mat(k, 32) = mat(k, 32) - dti(k) + mat(k, 34) = mat(k, 34) - dti(k) + mat(k, 35) = mat(k, 35) - dti(k) + mat(k, 36) = mat(k, 36) - dti(k) + mat(k, 39) = mat(k, 39) - dti(k) + mat(k, 42) = mat(k, 42) - dti(k) + mat(k, 45) = mat(k, 45) - dti(k) + mat(k, 48) = mat(k, 48) - dti(k) + mat(k, 51) = mat(k, 51) - dti(k) + mat(k, 54) = mat(k, 54) - dti(k) + mat(k, 57) = mat(k, 57) - dti(k) + mat(k, 60) = mat(k, 60) - dti(k) + mat(k, 63) = mat(k, 63) - dti(k) + mat(k, 66) = mat(k, 66) - dti(k) + mat(k, 69) = mat(k, 69) - dti(k) + mat(k, 73) = mat(k, 73) - dti(k) + mat(k, 77) = mat(k, 77) - dti(k) + mat(k, 81) = mat(k, 81) - dti(k) + mat(k, 84) = mat(k, 84) - dti(k) + mat(k, 87) = mat(k, 87) - dti(k) + mat(k, 89) = mat(k, 89) - dti(k) + mat(k, 93) = mat(k, 93) - dti(k) + mat(k, 97) = mat(k, 97) - dti(k) + mat(k, 100) = mat(k, 100) - dti(k) + mat(k, 103) = mat(k, 103) - dti(k) + mat(k, 108) = mat(k, 108) - dti(k) + mat(k, 111) = mat(k, 111) - dti(k) + mat(k, 116) = mat(k, 116) - dti(k) + mat(k, 120) = mat(k, 120) - dti(k) + mat(k, 124) = mat(k, 124) - dti(k) + mat(k, 130) = mat(k, 130) - dti(k) + mat(k, 136) = mat(k, 136) - dti(k) + mat(k, 142) = mat(k, 142) - dti(k) + mat(k, 147) = mat(k, 147) - dti(k) + mat(k, 152) = mat(k, 152) - dti(k) + mat(k, 157) = mat(k, 157) - dti(k) + mat(k, 160) = mat(k, 160) - dti(k) + mat(k, 168) = mat(k, 168) - dti(k) + mat(k, 176) = mat(k, 176) - dti(k) + mat(k, 182) = mat(k, 182) - dti(k) + mat(k, 188) = mat(k, 188) - dti(k) + mat(k, 194) = mat(k, 194) - dti(k) + mat(k, 200) = mat(k, 200) - dti(k) + mat(k, 206) = mat(k, 206) - dti(k) + mat(k, 213) = mat(k, 213) - dti(k) + mat(k, 220) = mat(k, 220) - dti(k) + mat(k, 227) = mat(k, 227) - dti(k) + mat(k, 234) = mat(k, 234) - dti(k) + mat(k, 240) = mat(k, 240) - dti(k) + mat(k, 248) = mat(k, 248) - dti(k) + mat(k, 252) = mat(k, 252) - dti(k) + mat(k, 260) = mat(k, 260) - dti(k) + mat(k, 268) = mat(k, 268) - dti(k) + mat(k, 276) = mat(k, 276) - dti(k) + mat(k, 283) = mat(k, 283) - dti(k) + mat(k, 292) = mat(k, 292) - dti(k) + mat(k, 301) = mat(k, 301) - dti(k) + mat(k, 308) = mat(k, 308) - dti(k) + mat(k, 318) = mat(k, 318) - dti(k) + mat(k, 323) = mat(k, 323) - dti(k) + mat(k, 328) = mat(k, 328) - dti(k) + mat(k, 336) = mat(k, 336) - dti(k) + mat(k, 342) = mat(k, 342) - dti(k) + mat(k, 352) = mat(k, 352) - dti(k) + mat(k, 360) = mat(k, 360) - dti(k) + mat(k, 369) = mat(k, 369) - dti(k) + mat(k, 377) = mat(k, 377) - dti(k) + mat(k, 389) = mat(k, 389) - dti(k) + mat(k, 401) = mat(k, 401) - dti(k) + mat(k, 408) = mat(k, 408) - dti(k) + mat(k, 416) = mat(k, 416) - dti(k) + mat(k, 422) = mat(k, 422) - dti(k) + mat(k, 429) = mat(k, 429) - dti(k) + mat(k, 448) = mat(k, 448) - dti(k) + mat(k, 459) = mat(k, 459) - dti(k) + mat(k, 467) = mat(k, 467) - dti(k) + mat(k, 477) = mat(k, 477) - dti(k) + mat(k, 492) = mat(k, 492) - dti(k) + mat(k, 503) = mat(k, 503) - dti(k) + mat(k, 510) = mat(k, 510) - dti(k) + mat(k, 514) = mat(k, 514) - dti(k) + mat(k, 530) = mat(k, 530) - dti(k) + mat(k, 550) = mat(k, 550) - dti(k) + mat(k, 560) = mat(k, 560) - dti(k) + mat(k, 578) = mat(k, 578) - dti(k) + mat(k, 591) = mat(k, 591) - dti(k) + mat(k, 602) = mat(k, 602) - dti(k) + mat(k, 626) = mat(k, 626) - dti(k) + mat(k, 649) = mat(k, 649) - dti(k) + mat(k, 668) = mat(k, 668) - dti(k) + mat(k, 695) = mat(k, 695) - dti(k) + mat(k, 715) = mat(k, 715) - dti(k) + mat(k, 753) = mat(k, 753) - dti(k) + mat(k, 769) = mat(k, 769) - dti(k) + mat(k, 783) = mat(k, 783) - dti(k) + mat(k, 800) = mat(k, 800) - dti(k) + mat(k, 820) = mat(k, 820) - dti(k) + mat(k, 856) = mat(k, 856) - dti(k) + mat(k, 886) = mat(k, 886) - dti(k) + mat(k, 943) = mat(k, 943) - dti(k) + mat(k, 966) = mat(k, 966) - dti(k) + mat(k,1011) = mat(k,1011) - dti(k) + mat(k,1048) = mat(k,1048) - dti(k) + mat(k,1086) = mat(k,1086) - dti(k) + mat(k,1172) = mat(k,1172) - dti(k) + mat(k,1217) = mat(k,1217) - dti(k) + mat(k,1243) = mat(k,1243) - dti(k) + mat(k,1286) = mat(k,1286) - dti(k) + mat(k,1307) = mat(k,1307) - dti(k) + end do + end subroutine nlnmat_finit + subroutine nlnmat( avec_len, mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: dti(veclen) + real(r8), intent(in) :: lmat(veclen,nzcnt) + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) + call nlnmat01( avec_len, mat, y, rxt ) + call nlnmat02( avec_len, mat, y, rxt ) + call nlnmat03( avec_len, mat, y, rxt ) + call nlnmat04( avec_len, mat, y, rxt ) + call nlnmat05( avec_len, mat, y, rxt ) + call nlnmat06( avec_len, mat, y, rxt ) + call nlnmat07( avec_len, mat, y, rxt ) + call nlnmat_finit( avec_len, mat, lmat, dti ) + end subroutine nlnmat + end module mo_nln_matrix diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_phtadj.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_phtadj.F90 new file mode 100644 index 0000000000..6698bf2f2b --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_phtadj.F90 @@ -0,0 +1,27 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + im(:ncol,k) = 1._r8 / m(:ncol,k) + p_rate(:,k, 5) = p_rate(:,k, 5) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 6) = p_rate(:,k, 6) * inv(:,k, 2) * im(:,k) + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_prod_loss.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_prod_loss.F90 new file mode 100644 index 0000000000..66d3674640 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_prod_loss.F90 @@ -0,0 +1,778 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : veclen + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( ofl, ofu, prod, loss, y, & + rxt, het_rates, chnkpnts ) + use chem_mods, only : gas_pcnst,rxntot,clscnt1 + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + integer, intent(in) :: ofl, ofu, chnkpnts + real(r8), dimension(chnkpnts,max(1,clscnt1)), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(chnkpnts,gas_pcnst) + real(r8), intent(in) :: rxt(chnkpnts,rxntot) + real(r8), intent(in) :: het_rates(chnkpnts,gas_pcnst) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k +!-------------------------------------------------------------------- +! ... loss and production for Explicit method +!-------------------------------------------------------------------- + do k = ofl,ofu + loss(k,1) = ( + het_rates(k,124))* y(k,124) + prod(k,1) = 0._r8 + loss(k,2) = ( + het_rates(k,125))* y(k,125) + prod(k,2) = 0._r8 + end do + end subroutine exp_prod_loss + subroutine imp_prod_loss( avec_len, prod, loss, y, & + rxt, het_rates ) + use chem_mods, only : gas_pcnst,rxntot,clscnt4 + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), dimension(veclen,clscnt4), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + do k = 1,avec_len + loss(k,1) = ( + het_rates(k,1))* y(k,1) + prod(k,1) = 0._r8 + loss(k,2) = ( + het_rates(k,2))* y(k,2) + prod(k,2) = 0._r8 + loss(k,35) = (rxt(k,293)* y(k,137) + het_rates(k,3))* y(k,3) + prod(k,35) = 0._r8 + loss(k,126) = (rxt(k,173)* y(k,25) +rxt(k,175)* y(k,98) +rxt(k,174)* y(k,132) & + + het_rates(k,4))* y(k,4) + prod(k,126) = (rxt(k,47) +2.000_r8*rxt(k,176)*y(k,6) +rxt(k,177)*y(k,41) + & + rxt(k,178)*y(k,41) +rxt(k,181)*y(k,88) +rxt(k,184)*y(k,97) + & + rxt(k,185)*y(k,137) +rxt(k,325)*y(k,110))*y(k,6) & + + (rxt(k,163)*y(k,17) +rxt(k,189)*y(k,18) + & + 3.000_r8*rxt(k,190)*y(k,37) +2.000_r8*rxt(k,191)*y(k,56) + & + rxt(k,192)*y(k,59) +2.000_r8*rxt(k,206)*y(k,24) +rxt(k,207)*y(k,26)) & + *y(k,136) + (rxt(k,187)*y(k,59) +2.000_r8*rxt(k,195)*y(k,24) + & + rxt(k,197)*y(k,26) +3.000_r8*rxt(k,202)*y(k,37))*y(k,137) & + + (2.000_r8*rxt(k,194)*y(k,24) +rxt(k,196)*y(k,26) + & + 3.000_r8*rxt(k,201)*y(k,37))*y(k,38) + (rxt(k,69) + & + rxt(k,186)*y(k,97))*y(k,59) +rxt(k,46)*y(k,5) +rxt(k,49)*y(k,7) & + +rxt(k,51)*y(k,17) +rxt(k,52)*y(k,18) +2.000_r8*rxt(k,58)*y(k,24) & + +rxt(k,59)*y(k,26) +3.000_r8*rxt(k,62)*y(k,37) +2.000_r8*rxt(k,68) & + *y(k,56) +rxt(k,75)*y(k,67) + loss(k,56) = ( + rxt(k,46) + het_rates(k,5))* y(k,5) + prod(k,56) = (rxt(k,351)*y(k,67) +rxt(k,356)*y(k,67))*y(k,63) & + +rxt(k,179)*y(k,41)*y(k,6) + loss(k,131) = (2._r8*rxt(k,176)* y(k,6) + (rxt(k,177) +rxt(k,178) + & + rxt(k,179))* y(k,41) +rxt(k,181)* y(k,88) +rxt(k,182)* y(k,89) & + +rxt(k,184)* y(k,97) +rxt(k,325)* y(k,110) +rxt(k,180)* y(k,132) & + +rxt(k,185)* y(k,137) + rxt(k,47) + het_rates(k,6))* y(k,6) + prod(k,131) = (rxt(k,48) +rxt(k,183)*y(k,97))*y(k,7) +rxt(k,175)*y(k,98) & + *y(k,4) +rxt(k,193)*y(k,136)*y(k,59) +rxt(k,188)*y(k,97)*y(k,67) + loss(k,83) = (rxt(k,183)* y(k,97) + rxt(k,48) + rxt(k,49) + rxt(k,345) & + + rxt(k,348) + rxt(k,353) + het_rates(k,7))* y(k,7) + prod(k,83) =rxt(k,182)*y(k,89)*y(k,6) + loss(k,3) = ( + het_rates(k,8))* y(k,8) + prod(k,3) = 0._r8 + loss(k,76) = (rxt(k,225)* y(k,38) +rxt(k,226)* y(k,98) +rxt(k,250)* y(k,137) & + + het_rates(k,9))* y(k,9) + prod(k,76) = 0._r8 + loss(k,57) = (rxt(k,231)* y(k,137) + het_rates(k,10))* y(k,10) + prod(k,57) = (.400_r8*rxt(k,227)*y(k,126) +.200_r8*rxt(k,228)*y(k,129)) & + *y(k,126) + loss(k,64) = (rxt(k,232)* y(k,137) + rxt(k,19) + het_rates(k,11))* y(k,11) + prod(k,64) =rxt(k,229)*y(k,132)*y(k,126) + loss(k,61) = (rxt(k,233)* y(k,38) +rxt(k,234)* y(k,137) + het_rates(k,12)) & + * y(k,12) + prod(k,61) = 0._r8 + loss(k,112) = (rxt(k,253)* y(k,90) +rxt(k,254)* y(k,98) +rxt(k,271)* y(k,137) & + + het_rates(k,13))* y(k,13) + prod(k,112) =.130_r8*rxt(k,304)*y(k,98)*y(k,71) +.700_r8*rxt(k,39)*y(k,77) + loss(k,71) = (rxt(k,258)* y(k,137) + rxt(k,20) + het_rates(k,14))* y(k,14) + prod(k,71) =rxt(k,256)*y(k,132)*y(k,127) + loss(k,45) = (rxt(k,259)* y(k,137) + het_rates(k,15))* y(k,15) + prod(k,45) = 0._r8 + loss(k,38) = (rxt(k,162)* y(k,136) + rxt(k,50) + het_rates(k,16))* y(k,16) + prod(k,38) = 0._r8 + loss(k,46) = (rxt(k,163)* y(k,136) + rxt(k,51) + het_rates(k,17))* y(k,17) + prod(k,46) = 0._r8 + loss(k,39) = (rxt(k,189)* y(k,136) + rxt(k,52) + het_rates(k,18))* y(k,18) + prod(k,39) = 0._r8 + loss(k,40) = (rxt(k,164)* y(k,136) + rxt(k,53) + het_rates(k,19))* y(k,19) + prod(k,40) = 0._r8 + loss(k,41) = (rxt(k,165)* y(k,136) + rxt(k,54) + het_rates(k,20))* y(k,20) + prod(k,41) = 0._r8 + loss(k,42) = (rxt(k,166)* y(k,136) + rxt(k,55) + het_rates(k,21))* y(k,21) + prod(k,42) = 0._r8 + loss(k,43) = (rxt(k,167)* y(k,136) + rxt(k,56) + het_rates(k,22))* y(k,22) + prod(k,43) = 0._r8 + loss(k,44) = (rxt(k,168)* y(k,136) + rxt(k,57) + het_rates(k,23))* y(k,23) + prod(k,44) = 0._r8 + loss(k,77) = (rxt(k,194)* y(k,38) +rxt(k,206)* y(k,136) +rxt(k,195)* y(k,137) & + + rxt(k,58) + het_rates(k,24))* y(k,24) + prod(k,77) = 0._r8 + loss(k,125) = (rxt(k,173)* y(k,4) +rxt(k,137)* y(k,38) +rxt(k,211)* y(k,90) & + +rxt(k,212)* y(k,97) +rxt(k,213)* y(k,137) + rxt(k,21) + rxt(k,22) & + + het_rates(k,25))* y(k,25) + prod(k,125) = (rxt(k,144)*y(k,41) +2.000_r8*rxt(k,214)*y(k,129) + & + rxt(k,215)*y(k,129) +rxt(k,217)*y(k,88) + & + .700_r8*rxt(k,228)*y(k,126) +rxt(k,238)*y(k,128) + & + rxt(k,255)*y(k,127) +.800_r8*rxt(k,267)*y(k,139) + & + .880_r8*rxt(k,274)*y(k,134) +2.000_r8*rxt(k,283)*y(k,135) + & + 1.200_r8*rxt(k,300)*y(k,133) +.800_r8*rxt(k,310)*y(k,140))*y(k,129) & + + (.500_r8*rxt(k,244)*y(k,131) +rxt(k,265)*y(k,138) + & + rxt(k,269)*y(k,139) +.250_r8*rxt(k,277)*y(k,134) + & + rxt(k,286)*y(k,135) +.072_r8*rxt(k,297)*y(k,72) + & + .550_r8*rxt(k,302)*y(k,133) +.250_r8*rxt(k,312)*y(k,140))*y(k,88) & + + (rxt(k,218)*y(k,34) +.300_r8*rxt(k,219)*y(k,35) + & + .500_r8*rxt(k,242)*y(k,33) +.800_r8*rxt(k,247)*y(k,52) + & + rxt(k,249)*y(k,103) +.500_r8*rxt(k,288)*y(k,76))*y(k,137) & + + (rxt(k,226)*y(k,9) +.500_r8*rxt(k,254)*y(k,13) + & + .120_r8*rxt(k,279)*y(k,74) +.600_r8*rxt(k,289)*y(k,77) + & + .910_r8*rxt(k,304)*y(k,71))*y(k,98) + (.250_r8*rxt(k,276)*y(k,134) + & + rxt(k,287)*y(k,135) +.072_r8*rxt(k,298)*y(k,72) + & + .600_r8*rxt(k,303)*y(k,133))*y(k,90) + (.250_r8*rxt(k,273)*y(k,134) + & + rxt(k,282)*y(k,135) +.600_r8*rxt(k,299)*y(k,133) + & + .250_r8*rxt(k,309)*y(k,140))*y(k,128) + (.180_r8*rxt(k,28) + & + rxt(k,222)*y(k,136) +rxt(k,223)*y(k,136))*y(k,36) & + + (.150_r8*rxt(k,268)*y(k,139) +.450_r8*rxt(k,284)*y(k,135) + & + .206_r8*rxt(k,296)*y(k,72))*y(k,132) +rxt(k,27)*y(k,35) +rxt(k,32) & + *y(k,52) +rxt(k,34)*y(k,69) +.690_r8*rxt(k,35)*y(k,73) & + +1.340_r8*rxt(k,36)*y(k,74) +rxt(k,40)*y(k,91) +rxt(k,41)*y(k,102) & + +rxt(k,43)*y(k,106) +rxt(k,44)*y(k,107) +2.000_r8*rxt(k,245) & + *y(k,130) +2.000_r8*rxt(k,285)*y(k,135)*y(k,135) + loss(k,86) = (rxt(k,196)* y(k,38) +rxt(k,207)* y(k,136) +rxt(k,197)* y(k,137) & + + rxt(k,59) + het_rates(k,26))* y(k,26) + prod(k,86) = 0._r8 + loss(k,47) = (rxt(k,198)* y(k,137) + rxt(k,60) + het_rates(k,27))* y(k,27) + prod(k,47) = 0._r8 + loss(k,113) = (rxt(k,235)* y(k,90) +rxt(k,236)* y(k,137) + rxt(k,23) & + + het_rates(k,28))* y(k,28) + prod(k,113) = (rxt(k,230)*y(k,126) +.270_r8*rxt(k,257)*y(k,127) + & + rxt(k,265)*y(k,138))*y(k,88) + (rxt(k,19) + & + .500_r8*rxt(k,232)*y(k,137))*y(k,11) + (.500_r8*rxt(k,254)*y(k,13) + & + .100_r8*rxt(k,289)*y(k,77))*y(k,98) + (1.600_r8*rxt(k,227)*y(k,126) + & + .800_r8*rxt(k,228)*y(k,129))*y(k,126) +rxt(k,231)*y(k,137)*y(k,10) & + +rxt(k,43)*y(k,106) + loss(k,68) = (rxt(k,199)* y(k,38) +rxt(k,200)* y(k,137) + rxt(k,61) & + + het_rates(k,29))* y(k,29) + prod(k,68) = 0._r8 + loss(k,95) = (rxt(k,272)* y(k,137) + rxt(k,24) + het_rates(k,30))* y(k,30) + prod(k,95) = (.820_r8*rxt(k,255)*y(k,129) +.820_r8*rxt(k,257)*y(k,88)) & + *y(k,127) +.820_r8*rxt(k,20)*y(k,14) +.100_r8*rxt(k,317)*y(k,137) & + *y(k,122) + loss(k,116) = (rxt(k,260)* y(k,90) +rxt(k,261)* y(k,137) + rxt(k,25) & + + het_rates(k,31))* y(k,31) + prod(k,116) = (.250_r8*rxt(k,273)*y(k,128) +.240_r8*rxt(k,274)*y(k,129) + & + .250_r8*rxt(k,276)*y(k,90) +.250_r8*rxt(k,277)*y(k,88))*y(k,134) & + + (.250_r8*rxt(k,309)*y(k,128) +.100_r8*rxt(k,310)*y(k,129) + & + .250_r8*rxt(k,312)*y(k,88) +.250_r8*rxt(k,313)*y(k,90))*y(k,140) & + + (.880_r8*rxt(k,279)*y(k,74) +.500_r8*rxt(k,289)*y(k,77))*y(k,98) & + + (rxt(k,262)*y(k,69) +rxt(k,263)*y(k,91))*y(k,137) & + +.020_r8*rxt(k,302)*y(k,133)*y(k,88) +.500_r8*rxt(k,267)*y(k,139) & + *y(k,129) + loss(k,89) = (rxt(k,241)* y(k,137) + het_rates(k,32))* y(k,32) + prod(k,89) = (.100_r8*rxt(k,238)*y(k,129) +.150_r8*rxt(k,239)*y(k,132)) & + *y(k,128) +.120_r8*rxt(k,254)*y(k,98)*y(k,13) & + +.150_r8*rxt(k,284)*y(k,135)*y(k,132) + loss(k,87) = (rxt(k,242)* y(k,137) + rxt(k,26) + het_rates(k,33))* y(k,33) + prod(k,87) = (.400_r8*rxt(k,239)*y(k,128) +.400_r8*rxt(k,284)*y(k,135)) & + *y(k,132) + loss(k,80) = (rxt(k,218)* y(k,137) + het_rates(k,34))* y(k,34) + prod(k,80) = (rxt(k,215)*y(k,129) +.300_r8*rxt(k,228)*y(k,126) + & + .500_r8*rxt(k,267)*y(k,139) +.250_r8*rxt(k,274)*y(k,134) + & + .250_r8*rxt(k,300)*y(k,133) +.300_r8*rxt(k,310)*y(k,140))*y(k,129) + loss(k,73) = (rxt(k,219)* y(k,137) + rxt(k,27) + het_rates(k,35))* y(k,35) + prod(k,73) =rxt(k,216)*y(k,132)*y(k,129) + loss(k,107) = (rxt(k,138)* y(k,38) + (rxt(k,221) +rxt(k,222) +rxt(k,223)) & + * y(k,136) +rxt(k,220)* y(k,137) + rxt(k,28) + rxt(k,29) & + + het_rates(k,36))* y(k,36) + prod(k,107) =.100_r8*rxt(k,254)*y(k,98)*y(k,13) + loss(k,70) = (rxt(k,201)* y(k,38) +rxt(k,190)* y(k,136) +rxt(k,202)* y(k,137) & + + rxt(k,62) + het_rates(k,37))* y(k,37) + prod(k,70) = 0._r8 + loss(k,128) = (rxt(k,233)* y(k,12) +rxt(k,194)* y(k,24) +rxt(k,137)* y(k,25) & + +rxt(k,196)* y(k,26) +rxt(k,199)* y(k,29) +rxt(k,138)* y(k,36) & + +rxt(k,201)* y(k,37) +rxt(k,150)* y(k,42) +rxt(k,139)* y(k,55) & + +rxt(k,140)* y(k,57) +rxt(k,159)* y(k,68) +rxt(k,143)* y(k,98) & + + (rxt(k,141) +rxt(k,142))* y(k,132) + het_rates(k,38))* y(k,38) + prod(k,128) = (4.000_r8*rxt(k,162)*y(k,16) +rxt(k,163)*y(k,17) + & + 3.000_r8*rxt(k,164)*y(k,19) +3.000_r8*rxt(k,165)*y(k,20) + & + 2.000_r8*rxt(k,166)*y(k,21) +rxt(k,167)*y(k,22) + & + 2.000_r8*rxt(k,168)*y(k,23) +rxt(k,169)*y(k,63) + & + 2.000_r8*rxt(k,208)*y(k,60) +rxt(k,209)*y(k,61) +rxt(k,210)*y(k,62)) & + *y(k,136) + (rxt(k,65) +rxt(k,144)*y(k,129) + & + 2.000_r8*rxt(k,145)*y(k,41) +rxt(k,147)*y(k,41) +rxt(k,149)*y(k,88) + & + rxt(k,154)*y(k,97) +rxt(k,155)*y(k,137) +rxt(k,178)*y(k,6) + & + rxt(k,326)*y(k,110))*y(k,41) + (rxt(k,158)*y(k,63) + & + 3.000_r8*rxt(k,198)*y(k,27) +rxt(k,200)*y(k,29) + & + 2.000_r8*rxt(k,203)*y(k,60) +rxt(k,204)*y(k,61) +rxt(k,205)*y(k,62)) & + *y(k,137) + (rxt(k,73) +rxt(k,157)*y(k,97))*y(k,63) +rxt(k,46)*y(k,5) & + +4.000_r8*rxt(k,50)*y(k,16) +rxt(k,51)*y(k,17) +3.000_r8*rxt(k,53) & + *y(k,19) +3.000_r8*rxt(k,54)*y(k,20) +2.000_r8*rxt(k,55)*y(k,21) & + +rxt(k,56)*y(k,22) +2.000_r8*rxt(k,57)*y(k,23) +3.000_r8*rxt(k,60) & + *y(k,27) +rxt(k,61)*y(k,29) +2.000_r8*rxt(k,63)*y(k,39) & + +2.000_r8*rxt(k,64)*y(k,40) +rxt(k,67)*y(k,42) +rxt(k,70)*y(k,60) & + +rxt(k,71)*y(k,61) +rxt(k,72)*y(k,62) +rxt(k,76)*y(k,68) + loss(k,50) = ( + rxt(k,63) + het_rates(k,39))* y(k,39) + prod(k,50) = (rxt(k,344)*y(k,68) +rxt(k,349)*y(k,42) +rxt(k,350)*y(k,68) + & + rxt(k,354)*y(k,42) +rxt(k,355)*y(k,68) +rxt(k,359)*y(k,42))*y(k,63) & + +rxt(k,150)*y(k,42)*y(k,38) +rxt(k,146)*y(k,41)*y(k,41) + loss(k,34) = ( + rxt(k,64) + rxt(k,172) + het_rates(k,40))* y(k,40) + prod(k,34) =rxt(k,171)*y(k,41)*y(k,41) + loss(k,137) = ((rxt(k,177) +rxt(k,178) +rxt(k,179))* y(k,6) & + + 2._r8*(rxt(k,145) +rxt(k,146) +rxt(k,147) +rxt(k,171))* y(k,41) & + +rxt(k,149)* y(k,88) +rxt(k,151)* y(k,89) +rxt(k,154)* y(k,97) & + +rxt(k,326)* y(k,110) +rxt(k,144)* y(k,129) +rxt(k,148)* y(k,132) & + + (rxt(k,155) +rxt(k,156))* y(k,137) + rxt(k,65) + het_rates(k,41)) & + * y(k,41) + prod(k,137) = (rxt(k,142)*y(k,132) +rxt(k,143)*y(k,98) +rxt(k,159)*y(k,68)) & + *y(k,38) + (rxt(k,66) +rxt(k,152)*y(k,97))*y(k,42) & + + (rxt(k,160)*y(k,97) +rxt(k,161)*y(k,137))*y(k,68) + (rxt(k,77) + & + rxt(k,331)*y(k,110))*y(k,100) +2.000_r8*rxt(k,172)*y(k,40) & + +rxt(k,170)*y(k,136)*y(k,63) + loss(k,104) = (rxt(k,150)* y(k,38) + (rxt(k,349) +rxt(k,354) +rxt(k,359)) & + * y(k,63) +rxt(k,152)* y(k,97) +rxt(k,153)* y(k,137) + rxt(k,66) & + + rxt(k,67) + rxt(k,347) + rxt(k,352) + rxt(k,358) & + + het_rates(k,42))* y(k,42) + prod(k,104) =rxt(k,151)*y(k,89)*y(k,41) + loss(k,4) = ( + het_rates(k,43))* y(k,43) + prod(k,4) = 0._r8 + loss(k,110) = (rxt(k,224)* y(k,137) + het_rates(k,44))* y(k,44) + prod(k,110) = (rxt(k,21) +rxt(k,22) +rxt(k,137)*y(k,38) +rxt(k,173)*y(k,4) + & + rxt(k,211)*y(k,90) +rxt(k,212)*y(k,97) +rxt(k,213)*y(k,137))*y(k,25) & + + (.630_r8*rxt(k,226)*y(k,9) +.560_r8*rxt(k,254)*y(k,13) + & + .650_r8*rxt(k,279)*y(k,74) +.560_r8*rxt(k,289)*y(k,77) + & + .620_r8*rxt(k,304)*y(k,71))*y(k,98) + (.220_r8*rxt(k,273)*y(k,128) + & + .110_r8*rxt(k,274)*y(k,129) +.220_r8*rxt(k,276)*y(k,90) + & + .220_r8*rxt(k,277)*y(k,88))*y(k,134) + (.250_r8*rxt(k,309)*y(k,128) + & + .200_r8*rxt(k,310)*y(k,129) +.250_r8*rxt(k,312)*y(k,88) + & + .500_r8*rxt(k,313)*y(k,90))*y(k,140) + (rxt(k,25) + & + rxt(k,260)*y(k,90) +rxt(k,261)*y(k,137))*y(k,31) + (rxt(k,80) + & + rxt(k,320)*y(k,97) +rxt(k,321)*y(k,137))*y(k,101) & + + (2.000_r8*rxt(k,33) +rxt(k,248)*y(k,137))*y(k,53) +rxt(k,23) & + *y(k,28) +rxt(k,199)*y(k,38)*y(k,29) +.380_r8*rxt(k,28)*y(k,36) & + +rxt(k,30)*y(k,45) +rxt(k,32)*y(k,52) +1.340_r8*rxt(k,37)*y(k,74) & + +.700_r8*rxt(k,39)*y(k,77) +rxt(k,41)*y(k,102) + loss(k,90) = ( + rxt(k,30) + het_rates(k,45))* y(k,45) + prod(k,90) = (rxt(k,224)*y(k,44) +rxt(k,241)*y(k,32) + & + .500_r8*rxt(k,242)*y(k,33) +.800_r8*rxt(k,247)*y(k,52) + & + rxt(k,248)*y(k,53) +.500_r8*rxt(k,288)*y(k,76))*y(k,137) & + + (2.000_r8*rxt(k,237)*y(k,128) +.900_r8*rxt(k,238)*y(k,129) + & + rxt(k,240)*y(k,88) +2.000_r8*rxt(k,282)*y(k,135) + & + rxt(k,309)*y(k,140))*y(k,128) + (rxt(k,283)*y(k,129) + & + .450_r8*rxt(k,284)*y(k,132) +2.000_r8*rxt(k,285)*y(k,135))*y(k,135) & + + (.200_r8*rxt(k,254)*y(k,13) +.100_r8*rxt(k,289)*y(k,77))*y(k,98) & + +rxt(k,26)*y(k,33) +.440_r8*rxt(k,28)*y(k,36) +.400_r8*rxt(k,42) & + *y(k,103) + loss(k,62) = (rxt(k,318)* y(k,90) + (rxt(k,319) +rxt(k,333))* y(k,137) & + + het_rates(k,46))* y(k,46) + prod(k,62) = 0._r8 + loss(k,5) = ( + het_rates(k,47))* y(k,47) + prod(k,5) = 0._r8 + loss(k,6) = ( + het_rates(k,48))* y(k,48) + prod(k,6) = 0._r8 + loss(k,7) = ( + het_rates(k,49))* y(k,49) + prod(k,7) = 0._r8 + loss(k,8) = ( + rxt(k,360) + het_rates(k,50))* y(k,50) + prod(k,8) = 0._r8 + loss(k,48) = ( + rxt(k,31) + het_rates(k,51))* y(k,51) + prod(k,48) =rxt(k,243)*y(k,132)*y(k,131) + loss(k,105) = (rxt(k,247)* y(k,137) + rxt(k,32) + het_rates(k,52))* y(k,52) + prod(k,105) = (.530_r8*rxt(k,273)*y(k,128) +.260_r8*rxt(k,274)*y(k,129) + & + .530_r8*rxt(k,276)*y(k,90) +.530_r8*rxt(k,277)*y(k,88))*y(k,134) & + + (.250_r8*rxt(k,309)*y(k,128) +.100_r8*rxt(k,310)*y(k,129) + & + .250_r8*rxt(k,312)*y(k,88) +.250_r8*rxt(k,313)*y(k,90))*y(k,140) & + +.020_r8*rxt(k,302)*y(k,133)*y(k,88) +rxt(k,246)*y(k,130) + loss(k,92) = (rxt(k,248)* y(k,137) + rxt(k,33) + het_rates(k,53))* y(k,53) + prod(k,92) = (.250_r8*rxt(k,309)*y(k,128) +.100_r8*rxt(k,310)*y(k,129) + & + .250_r8*rxt(k,312)*y(k,88) +.250_r8*rxt(k,313)*y(k,90))*y(k,140) & + +.200_r8*rxt(k,247)*y(k,137)*y(k,52) +.020_r8*rxt(k,302)*y(k,133) & + *y(k,88) + loss(k,124) = (rxt(k,103)* y(k,98) + (rxt(k,97) +rxt(k,98) +rxt(k,99)) & + * y(k,132) + rxt(k,100) + het_rates(k,54))* y(k,54) + prod(k,124) = (rxt(k,104)*y(k,55) +rxt(k,107)*y(k,97) +rxt(k,125)*y(k,78) + & + rxt(k,213)*y(k,25) +rxt(k,321)*y(k,101) +rxt(k,327)*y(k,108) + & + rxt(k,332)*y(k,110))*y(k,137) + (rxt(k,86)*y(k,55) + & + rxt(k,170)*y(k,63) +rxt(k,193)*y(k,59) +rxt(k,222)*y(k,36))*y(k,136) & + + (.330_r8*rxt(k,28) +rxt(k,29))*y(k,36) + (rxt(k,95)*y(k,97) + & + rxt(k,139)*y(k,38))*y(k,55) + (rxt(k,2) +2.000_r8*rxt(k,3))*y(k,141) & + +2.000_r8*rxt(k,21)*y(k,25) +rxt(k,27)*y(k,35) +rxt(k,69)*y(k,59) & + +rxt(k,73)*y(k,63) +rxt(k,74)*y(k,64) + loss(k,111) = (rxt(k,139)* y(k,38) +rxt(k,95)* y(k,97) +rxt(k,86)* y(k,136) & + +rxt(k,104)* y(k,137) + het_rates(k,55))* y(k,55) + prod(k,111) = (1.440_r8*rxt(k,28) +rxt(k,223)*y(k,136))*y(k,36) +rxt(k,22) & + *y(k,25) +rxt(k,97)*y(k,132)*y(k,54) +rxt(k,1)*y(k,141) + loss(k,36) = (rxt(k,191)* y(k,136) + rxt(k,68) + het_rates(k,56))* y(k,56) + prod(k,36) = 0._r8 + loss(k,84) = (rxt(k,140)* y(k,38) +rxt(k,96)* y(k,97) +rxt(k,105)* y(k,137) & + + rxt(k,4) + het_rates(k,57))* y(k,57) + prod(k,84) =rxt(k,111)*y(k,132)*y(k,132) +rxt(k,110)*y(k,137)*y(k,137) + loss(k,49) = ( + rxt(k,79) + het_rates(k,58))* y(k,58) + prod(k,49) =rxt(k,334)*y(k,141)*y(k,112) + loss(k,100) = (rxt(k,186)* y(k,97) + (rxt(k,192) +rxt(k,193))* y(k,136) & + +rxt(k,187)* y(k,137) + rxt(k,69) + het_rates(k,59))* y(k,59) + prod(k,100) = (rxt(k,173)*y(k,25) +rxt(k,174)*y(k,132))*y(k,4) + loss(k,51) = (rxt(k,208)* y(k,136) +rxt(k,203)* y(k,137) + rxt(k,70) & + + het_rates(k,60))* y(k,60) + prod(k,51) = 0._r8 + loss(k,52) = (rxt(k,209)* y(k,136) +rxt(k,204)* y(k,137) + rxt(k,71) & + + het_rates(k,61))* y(k,61) + prod(k,52) = 0._r8 + loss(k,55) = (rxt(k,210)* y(k,136) +rxt(k,205)* y(k,137) + rxt(k,72) & + + het_rates(k,62))* y(k,62) + prod(k,55) = 0._r8 + loss(k,127) = ((rxt(k,349) +rxt(k,354) +rxt(k,359))* y(k,42) + (rxt(k,351) + & + rxt(k,356))* y(k,67) + (rxt(k,344) +rxt(k,350) +rxt(k,355))* y(k,68) & + +rxt(k,157)* y(k,97) + (rxt(k,169) +rxt(k,170))* y(k,136) & + +rxt(k,158)* y(k,137) + rxt(k,73) + het_rates(k,63))* y(k,63) + prod(k,127) = (rxt(k,137)*y(k,25) +rxt(k,138)*y(k,36) +rxt(k,139)*y(k,55) + & + rxt(k,140)*y(k,57) +rxt(k,141)*y(k,132) +rxt(k,159)*y(k,68) + & + rxt(k,194)*y(k,24) +rxt(k,196)*y(k,26) +2.000_r8*rxt(k,199)*y(k,29) + & + rxt(k,201)*y(k,37) +rxt(k,233)*y(k,12))*y(k,38) +rxt(k,156)*y(k,137) & + *y(k,41) + loss(k,9) = ( + rxt(k,74) + het_rates(k,64))* y(k,64) + prod(k,9) = 0._r8 + loss(k,101) = (rxt(k,134)* y(k,137) + rxt(k,9) + het_rates(k,65))* y(k,65) + prod(k,101) = (rxt(k,347) +rxt(k,352) +rxt(k,358) +rxt(k,349)*y(k,63) + & + rxt(k,354)*y(k,63) +rxt(k,359)*y(k,63))*y(k,42) + (rxt(k,340) + & + rxt(k,211)*y(k,25) +rxt(k,235)*y(k,28) +rxt(k,260)*y(k,31) + & + rxt(k,318)*y(k,46))*y(k,90) + (2.000_r8*rxt(k,337) + & + 2.000_r8*rxt(k,343) +2.000_r8*rxt(k,346) +2.000_r8*rxt(k,357)) & + *y(k,80) + (rxt(k,345) +rxt(k,348) +rxt(k,353))*y(k,7) & + + (.500_r8*rxt(k,339) +rxt(k,133)*y(k,137))*y(k,89) +rxt(k,341) & + *y(k,102) + loss(k,69) = (rxt(k,112)* y(k,137) + rxt(k,10) + rxt(k,11) + rxt(k,135) & + + het_rates(k,66))* y(k,66) + prod(k,69) =rxt(k,131)*y(k,132)*y(k,89) + loss(k,94) = ((rxt(k,351) +rxt(k,356))* y(k,63) +rxt(k,188)* y(k,97) & + + rxt(k,75) + het_rates(k,67))* y(k,67) + prod(k,94) = (rxt(k,345) +rxt(k,348) +rxt(k,353))*y(k,7) +rxt(k,180)*y(k,132) & + *y(k,6) + loss(k,99) = (rxt(k,159)* y(k,38) + (rxt(k,344) +rxt(k,350) +rxt(k,355)) & + * y(k,63) +rxt(k,160)* y(k,97) +rxt(k,161)* y(k,137) + rxt(k,76) & + + het_rates(k,68))* y(k,68) + prod(k,99) = (rxt(k,347) +rxt(k,352) +rxt(k,358) +rxt(k,153)*y(k,137)) & + *y(k,42) +rxt(k,148)*y(k,132)*y(k,41) + loss(k,109) = (rxt(k,262)* y(k,137) + rxt(k,34) + het_rates(k,69))* y(k,69) + prod(k,109) = (.220_r8*rxt(k,273)*y(k,128) +.230_r8*rxt(k,274)*y(k,129) + & + .220_r8*rxt(k,276)*y(k,90) +.220_r8*rxt(k,277)*y(k,88))*y(k,134) & + + (.250_r8*rxt(k,309)*y(k,128) +.100_r8*rxt(k,310)*y(k,129) + & + .250_r8*rxt(k,312)*y(k,88) +.250_r8*rxt(k,313)*y(k,90))*y(k,140) & + + (.500_r8*rxt(k,266)*y(k,106) +.500_r8*rxt(k,288)*y(k,76))*y(k,137) & + +.020_r8*rxt(k,302)*y(k,133)*y(k,88) +.200_r8*rxt(k,267)*y(k,139) & + *y(k,129) + loss(k,66) = (rxt(k,294)* y(k,137) + het_rates(k,70))* y(k,70) + prod(k,66) = (.400_r8*rxt(k,299)*y(k,128) +.300_r8*rxt(k,300)*y(k,129) + & + .330_r8*rxt(k,302)*y(k,88) +.400_r8*rxt(k,303)*y(k,90))*y(k,133) & + + (rxt(k,307)*y(k,90) +rxt(k,308)*y(k,137))*y(k,102) + loss(k,103) = (rxt(k,295)* y(k,90) +rxt(k,304)* y(k,98) +rxt(k,305)* y(k,137) & + + het_rates(k,71))* y(k,71) + prod(k,103) = 0._r8 + loss(k,97) = (rxt(k,297)* y(k,88) +rxt(k,298)* y(k,90) +rxt(k,296)* y(k,132) & + + het_rates(k,72))* y(k,72) + prod(k,97) =rxt(k,295)*y(k,90)*y(k,71) + loss(k,79) = (rxt(k,306)* y(k,137) + rxt(k,35) + het_rates(k,73))* y(k,73) + prod(k,79) =rxt(k,301)*y(k,133)*y(k,132) + loss(k,114) = (rxt(k,279)* y(k,98) +rxt(k,280)* y(k,137) + rxt(k,36) & + + rxt(k,37) + het_rates(k,74))* y(k,74) + prod(k,114) = (.250_r8*rxt(k,299)*y(k,128) +.190_r8*rxt(k,300)*y(k,129) + & + .230_r8*rxt(k,302)*y(k,88) +.250_r8*rxt(k,303)*y(k,90))*y(k,133) & + + (.167_r8*rxt(k,296)*y(k,132) +.167_r8*rxt(k,297)*y(k,88) + & + .167_r8*rxt(k,298)*y(k,90))*y(k,72) + (.300_r8*rxt(k,304)*y(k,71) + & + 1.122_r8*rxt(k,316)*y(k,122))*y(k,98) +.288_r8*rxt(k,35)*y(k,73) + loss(k,63) = (rxt(k,281)* y(k,137) + het_rates(k,75))* y(k,75) + prod(k,63) =rxt(k,275)*y(k,134)*y(k,132) + loss(k,85) = (rxt(k,288)* y(k,137) + rxt(k,38) + rxt(k,292) & + + het_rates(k,76))* y(k,76) + prod(k,85) =rxt(k,291)*y(k,135)*y(k,89) + loss(k,122) = (rxt(k,289)* y(k,98) +rxt(k,290)* y(k,137) + rxt(k,39) & + + het_rates(k,77))* y(k,77) + prod(k,122) = (.350_r8*rxt(k,299)*y(k,128) +.260_r8*rxt(k,300)*y(k,129) + & + .320_r8*rxt(k,302)*y(k,88) +.350_r8*rxt(k,303)*y(k,90))*y(k,133) & + + (.039_r8*rxt(k,296)*y(k,132) +.039_r8*rxt(k,297)*y(k,88) + & + .039_r8*rxt(k,298)*y(k,90))*y(k,72) + (.200_r8*rxt(k,304)*y(k,71) + & + .442_r8*rxt(k,316)*y(k,122))*y(k,98) +.402_r8*rxt(k,35)*y(k,73) + loss(k,75) = (rxt(k,113)* y(k,88) + (rxt(k,114) +rxt(k,115) +rxt(k,116)) & + * y(k,89) +rxt(k,125)* y(k,137) + rxt(k,117) + het_rates(k,78)) & + * y(k,78) + prod(k,75) =rxt(k,15)*y(k,88) + loss(k,53) = ((rxt(k,129) +rxt(k,130))* y(k,136) + rxt(k,12) & + + het_rates(k,79))* y(k,79) + prod(k,53) =rxt(k,114)*y(k,89)*y(k,78) + loss(k,60) = ( + rxt(k,13) + rxt(k,14) + rxt(k,136) + rxt(k,337) + rxt(k,343) & + + rxt(k,346) + rxt(k,357) + het_rates(k,80))* y(k,80) + prod(k,60) =rxt(k,132)*y(k,90)*y(k,89) + loss(k,10) = ( + het_rates(k,81))* y(k,81) + prod(k,10) = 0._r8 + loss(k,11) = ( + het_rates(k,82))* y(k,82) + prod(k,11) = 0._r8 + loss(k,12) = ( + het_rates(k,83))* y(k,83) + prod(k,12) = 0._r8 + loss(k,37) = (rxt(k,335)* y(k,137) + het_rates(k,84))* y(k,84) + prod(k,37) = 0._r8 + loss(k,13) = ( + rxt(k,338) + het_rates(k,85))* y(k,85) + prod(k,13) = 0._r8 + loss(k,14) = ( + rxt(k,362) + het_rates(k,86))* y(k,86) + prod(k,14) = 0._r8 + loss(k,15) = ( + rxt(k,361) + het_rates(k,87))* y(k,87) + prod(k,15) = 0._r8 + loss(k,138) = (rxt(k,181)* y(k,6) +rxt(k,149)* y(k,41) +rxt(k,297)* y(k,72) & + +rxt(k,113)* y(k,78) +rxt(k,122)* y(k,90) +rxt(k,128)* y(k,97) & + +rxt(k,127)* y(k,98) +rxt(k,230)* y(k,126) +rxt(k,257)* y(k,127) & + +rxt(k,240)* y(k,128) +rxt(k,217)* y(k,129) +rxt(k,244)* y(k,131) & + +rxt(k,126)* y(k,132) +rxt(k,302)* y(k,133) + (rxt(k,277) + & + rxt(k,278))* y(k,134) +rxt(k,286)* y(k,135) +rxt(k,265)* y(k,138) & + +rxt(k,269)* y(k,139) +rxt(k,312)* y(k,140) + rxt(k,15) & + + het_rates(k,88))* y(k,88) + prod(k,138) = (rxt(k,16) +.500_r8*rxt(k,339) +2.000_r8*rxt(k,115)*y(k,78) + & + rxt(k,118)*y(k,97) +rxt(k,328)*y(k,110))*y(k,89) + (rxt(k,117) + & + rxt(k,125)*y(k,137))*y(k,78) +2.000_r8*rxt(k,129)*y(k,136)*y(k,79) & + +rxt(k,14)*y(k,80) +rxt(k,17)*y(k,90) + loss(k,133) = (rxt(k,182)* y(k,6) +rxt(k,151)* y(k,41) + (rxt(k,114) + & + rxt(k,115) +rxt(k,116))* y(k,78) +rxt(k,132)* y(k,90) + (rxt(k,118) + & + rxt(k,120))* y(k,97) +rxt(k,119)* y(k,98) +rxt(k,328)* y(k,110) & + +rxt(k,251)* y(k,128) +rxt(k,131)* y(k,132) +rxt(k,291)* y(k,135) & + +rxt(k,133)* y(k,137) + rxt(k,16) + rxt(k,339) + het_rates(k,89)) & + * y(k,89) + prod(k,133) = (2.000_r8*rxt(k,122)*y(k,90) +rxt(k,126)*y(k,132) + & + rxt(k,127)*y(k,98) +rxt(k,128)*y(k,97) +rxt(k,149)*y(k,41) + & + rxt(k,181)*y(k,6) +rxt(k,217)*y(k,129) +rxt(k,230)*y(k,126) + & + rxt(k,240)*y(k,128) +rxt(k,244)*y(k,131) +rxt(k,257)*y(k,127) + & + rxt(k,265)*y(k,138) +rxt(k,269)*y(k,139) +rxt(k,277)*y(k,134) + & + rxt(k,286)*y(k,135) +1.206_r8*rxt(k,297)*y(k,72) + & + .920_r8*rxt(k,302)*y(k,133) +rxt(k,312)*y(k,140))*y(k,88) & + + (rxt(k,18) +rxt(k,121)*y(k,132) +rxt(k,123)*y(k,97) + & + rxt(k,124)*y(k,137) +rxt(k,276)*y(k,134) +rxt(k,287)*y(k,135) + & + 1.206_r8*rxt(k,298)*y(k,72) +rxt(k,303)*y(k,133) + & + rxt(k,307)*y(k,102) +rxt(k,313)*y(k,140) +rxt(k,315)*y(k,122)) & + *y(k,90) + (rxt(k,11) +rxt(k,135) +rxt(k,112)*y(k,137))*y(k,66) & + + (rxt(k,38) +rxt(k,292))*y(k,76) + (rxt(k,13) +rxt(k,136))*y(k,80) & + + (rxt(k,40) +rxt(k,263)*y(k,137))*y(k,91) + (rxt(k,41) + & + .400_r8*rxt(k,308)*y(k,137))*y(k,102) + (.600_r8*rxt(k,42) + & + rxt(k,252))*y(k,103) +rxt(k,48)*y(k,7) +rxt(k,66)*y(k,42) +rxt(k,9) & + *y(k,65) +.206_r8*rxt(k,296)*y(k,132)*y(k,72) + loss(k,136) = (rxt(k,253)* y(k,13) +rxt(k,211)* y(k,25) +rxt(k,235)* y(k,28) & + +rxt(k,260)* y(k,31) +rxt(k,318)* y(k,46) +rxt(k,295)* y(k,71) & + +rxt(k,298)* y(k,72) +rxt(k,122)* y(k,88) +rxt(k,132)* y(k,89) & + +rxt(k,123)* y(k,97) +rxt(k,307)* y(k,102) +rxt(k,315)* y(k,122) & + +rxt(k,121)* y(k,132) +rxt(k,303)* y(k,133) +rxt(k,276)* y(k,134) & + +rxt(k,287)* y(k,135) +rxt(k,124)* y(k,137) +rxt(k,313)* y(k,140) & + + rxt(k,17) + rxt(k,18) + rxt(k,340) + het_rates(k,90))* y(k,90) + prod(k,136) = (rxt(k,67) +rxt(k,150)*y(k,38) +rxt(k,152)*y(k,97) + & + rxt(k,153)*y(k,137))*y(k,42) + (rxt(k,13) +rxt(k,14) +rxt(k,136)) & + *y(k,80) + (rxt(k,134)*y(k,65) +rxt(k,249)*y(k,103) + & + .500_r8*rxt(k,288)*y(k,76))*y(k,137) + (rxt(k,49) + & + rxt(k,183)*y(k,97))*y(k,7) + (rxt(k,119)*y(k,98) +rxt(k,120)*y(k,97)) & + *y(k,89) +rxt(k,10)*y(k,66) +.400_r8*rxt(k,42)*y(k,103) + loss(k,72) = (rxt(k,263)* y(k,137) + rxt(k,40) + het_rates(k,91))* y(k,91) + prod(k,72) =rxt(k,253)*y(k,90)*y(k,13) + loss(k,16) = ( + het_rates(k,92))* y(k,92) + prod(k,16) = 0._r8 + loss(k,17) = ( + het_rates(k,93))* y(k,93) + prod(k,17) = 0._r8 + loss(k,18) = ( + het_rates(k,94))* y(k,94) + prod(k,18) = 0._r8 + loss(k,19) = ( + het_rates(k,95))* y(k,95) + prod(k,19) = 0._r8 + loss(k,20) = ( + het_rates(k,96))* y(k,96) + prod(k,20) = 0._r8 + loss(k,129) = (rxt(k,184)* y(k,6) +rxt(k,183)* y(k,7) +rxt(k,212)* y(k,25) & + +rxt(k,154)* y(k,41) +rxt(k,152)* y(k,42) +rxt(k,95)* y(k,55) & + +rxt(k,96)* y(k,57) +rxt(k,186)* y(k,59) +rxt(k,157)* y(k,63) & + +rxt(k,188)* y(k,67) +rxt(k,160)* y(k,68) +rxt(k,128)* y(k,88) & + + (rxt(k,118) +rxt(k,120))* y(k,89) +rxt(k,123)* y(k,90) & + + 2._r8*rxt(k,93)* y(k,97) +rxt(k,92)* y(k,98) +rxt(k,320)* y(k,101) & + +rxt(k,101)* y(k,132) +rxt(k,107)* y(k,137) + rxt(k,94) & + + het_rates(k,97))* y(k,97) + prod(k,129) = (rxt(k,117) +rxt(k,113)*y(k,88) +rxt(k,114)*y(k,89))*y(k,78) & + + (rxt(k,8) +2.000_r8*rxt(k,91)*y(k,136) + & + .765_r8*rxt(k,316)*y(k,122))*y(k,98) + (rxt(k,81) +rxt(k,329)) & + *y(k,110) + (rxt(k,88) +rxt(k,89))*y(k,136) +rxt(k,47)*y(k,6) & + +.180_r8*rxt(k,28)*y(k,36) +rxt(k,65)*y(k,41) +rxt(k,30)*y(k,45) & + +rxt(k,99)*y(k,132)*y(k,54) +rxt(k,14)*y(k,80) +rxt(k,15)*y(k,88) & + +rxt(k,16)*y(k,89) +rxt(k,18)*y(k,90) +rxt(k,77)*y(k,100) & + +rxt(k,322)*y(k,108) +rxt(k,82)*y(k,111) +rxt(k,83)*y(k,112) & + +rxt(k,109)*y(k,137)*y(k,137) +rxt(k,3)*y(k,141) + loss(k,132) = (rxt(k,175)* y(k,4) +rxt(k,226)* y(k,9) +rxt(k,254)* y(k,13) & + +rxt(k,143)* y(k,38) +rxt(k,103)* y(k,54) +rxt(k,304)* y(k,71) & + +rxt(k,279)* y(k,74) +rxt(k,289)* y(k,77) +rxt(k,127)* y(k,88) & + +rxt(k,119)* y(k,89) +rxt(k,92)* y(k,97) +rxt(k,324)* y(k,108) & + +rxt(k,330)* y(k,110) +rxt(k,316)* y(k,122) +rxt(k,102)* y(k,132) & + + (rxt(k,90) +rxt(k,91))* y(k,136) +rxt(k,108)* y(k,137) + rxt(k,7) & + + rxt(k,8) + het_rates(k,98))* y(k,98) + prod(k,132) = (.150_r8*rxt(k,239)*y(k,128) +.150_r8*rxt(k,284)*y(k,135)) & + *y(k,132) +rxt(k,94)*y(k,97) + loss(k,21) = ( + het_rates(k,99))* y(k,99) + prod(k,21) = 0._r8 + loss(k,65) = (rxt(k,331)* y(k,110) + rxt(k,77) + het_rates(k,100))* y(k,100) + prod(k,65) = (rxt(k,147)*y(k,41) +rxt(k,177)*y(k,6))*y(k,41) + loss(k,67) = (rxt(k,320)* y(k,97) +rxt(k,321)* y(k,137) + rxt(k,80) & + + het_rates(k,101))* y(k,101) + prod(k,67) = 0._r8 + loss(k,106) = (rxt(k,307)* y(k,90) +rxt(k,308)* y(k,137) + rxt(k,41) & + + rxt(k,341) + het_rates(k,102))* y(k,102) + prod(k,106) = (.794_r8*rxt(k,296)*y(k,132) +.794_r8*rxt(k,297)*y(k,88) + & + .794_r8*rxt(k,298)*y(k,90))*y(k,72) + (.800_r8*rxt(k,278)*y(k,134) + & + .080_r8*rxt(k,302)*y(k,133))*y(k,88) + loss(k,81) = (rxt(k,249)* y(k,137) + rxt(k,42) + rxt(k,252) & + + het_rates(k,103))* y(k,103) + prod(k,81) =rxt(k,251)*y(k,128)*y(k,89) + loss(k,22) = ( + het_rates(k,104))* y(k,104) + prod(k,22) = 0._r8 + loss(k,23) = ( + het_rates(k,105))* y(k,105) + prod(k,23) = 0._r8 + loss(k,82) = (rxt(k,266)* y(k,137) + rxt(k,43) + het_rates(k,106))* y(k,106) + prod(k,82) =rxt(k,264)*y(k,138)*y(k,132) + loss(k,74) = (rxt(k,270)* y(k,137) + rxt(k,44) + het_rates(k,107))* y(k,107) + prod(k,74) =.850_r8*rxt(k,268)*y(k,139)*y(k,132) + loss(k,78) = (rxt(k,324)* y(k,98) +rxt(k,327)* y(k,137) + rxt(k,322) & + + het_rates(k,108))* y(k,108) + prod(k,78) =rxt(k,80)*y(k,101) +rxt(k,81)*y(k,110) + loss(k,24) = ( + rxt(k,78) + het_rates(k,109))* y(k,109) + prod(k,24) = 0._r8 + loss(k,117) = (rxt(k,325)* y(k,6) +rxt(k,326)* y(k,41) +rxt(k,328)* y(k,89) & + +rxt(k,330)* y(k,98) +rxt(k,331)* y(k,100) +rxt(k,332)* y(k,137) & + + rxt(k,81) + rxt(k,329) + het_rates(k,110))* y(k,110) + prod(k,117) = (rxt(k,322) +rxt(k,324)*y(k,98) +rxt(k,327)*y(k,137))*y(k,108) & + +rxt(k,320)*y(k,101)*y(k,97) +rxt(k,82)*y(k,111) + loss(k,102) = (rxt(k,323)* y(k,137) + rxt(k,82) + het_rates(k,111))* y(k,111) + prod(k,102) = (rxt(k,329) +rxt(k,325)*y(k,6) +rxt(k,326)*y(k,41) + & + rxt(k,328)*y(k,89) +rxt(k,330)*y(k,98) +rxt(k,331)*y(k,100) + & + rxt(k,332)*y(k,137))*y(k,110) + (rxt(k,318)*y(k,90) + & + rxt(k,319)*y(k,137) +.500_r8*rxt(k,333)*y(k,137))*y(k,46) & + +rxt(k,321)*y(k,137)*y(k,101) +rxt(k,83)*y(k,112) + loss(k,58) = (rxt(k,334)* y(k,141) + rxt(k,83) + het_rates(k,112))* y(k,112) + prod(k,58) =rxt(k,79)*y(k,58) +rxt(k,323)*y(k,137)*y(k,111) + loss(k,25) = ( + het_rates(k,113))* y(k,113) + prod(k,25) = 0._r8 + loss(k,26) = ( + het_rates(k,114))* y(k,114) + prod(k,26) = 0._r8 + loss(k,27) = ( + het_rates(k,115))* y(k,115) + prod(k,27) = 0._r8 + loss(k,28) = ( + het_rates(k,116))* y(k,116) + prod(k,28) = 0._r8 + loss(k,29) = ( + rxt(k,84) + het_rates(k,117))* y(k,117) + prod(k,29) = 0._r8 + loss(k,30) = ( + rxt(k,85) + het_rates(k,118))* y(k,118) + prod(k,30) = 0._r8 + loss(k,31) = ( + rxt(k,342) + het_rates(k,119))* y(k,119) + prod(k,31) = 0._r8 + loss(k,32) = ( + het_rates(k,120))* y(k,120) + prod(k,32) =rxt(k,342)*y(k,119) + loss(k,33) = ( + rxt(k,363) + het_rates(k,121))* y(k,121) + prod(k,33) = 0._r8 + loss(k,88) = (rxt(k,315)* y(k,90) +rxt(k,316)* y(k,98) +rxt(k,317)* y(k,137) & + + het_rates(k,122))* y(k,122) + prod(k,88) = 0._r8 + loss(k,54) = (rxt(k,314)* y(k,137) + rxt(k,45) + het_rates(k,123))* y(k,123) + prod(k,54) =rxt(k,311)*y(k,140)*y(k,132) + loss(k,96) = (rxt(k,230)* y(k,88) + 2._r8*rxt(k,227)* y(k,126) +rxt(k,228) & + * y(k,129) +rxt(k,229)* y(k,132) + het_rates(k,126))* y(k,126) + prod(k,96) = (rxt(k,233)*y(k,38) +rxt(k,234)*y(k,137))*y(k,12) & + +.500_r8*rxt(k,232)*y(k,137)*y(k,11) + loss(k,98) = (rxt(k,257)* y(k,88) +rxt(k,255)* y(k,129) +rxt(k,256)* y(k,132) & + + het_rates(k,127))* y(k,127) + prod(k,98) = (rxt(k,258)*y(k,14) +rxt(k,259)*y(k,15) + & + 1.670_r8*rxt(k,293)*y(k,3))*y(k,137) + loss(k,121) = (rxt(k,240)* y(k,88) +rxt(k,251)* y(k,89) + 2._r8*rxt(k,237) & + * y(k,128) +rxt(k,238)* y(k,129) +rxt(k,239)* y(k,132) +rxt(k,299) & + * y(k,133) +rxt(k,273)* y(k,134) +rxt(k,309)* y(k,140) & + + het_rates(k,128))* y(k,128) + prod(k,121) = (rxt(k,283)*y(k,129) +.450_r8*rxt(k,284)*y(k,132) + & + 2.000_r8*rxt(k,285)*y(k,135) +rxt(k,286)*y(k,88) +rxt(k,287)*y(k,90)) & + *y(k,135) + (.530_r8*rxt(k,273)*y(k,128) + & + .260_r8*rxt(k,274)*y(k,129) +.530_r8*rxt(k,276)*y(k,90) + & + .530_r8*rxt(k,277)*y(k,88))*y(k,134) + (rxt(k,25) + & + rxt(k,260)*y(k,90) +rxt(k,261)*y(k,137))*y(k,31) & + + (.100_r8*rxt(k,279)*y(k,74) +.280_r8*rxt(k,289)*y(k,77) + & + .080_r8*rxt(k,304)*y(k,71))*y(k,98) + (.300_r8*rxt(k,267)*y(k,129) + & + .150_r8*rxt(k,268)*y(k,132) +rxt(k,269)*y(k,88))*y(k,139) & + + (rxt(k,235)*y(k,90) +rxt(k,236)*y(k,137))*y(k,28) & + + (.600_r8*rxt(k,42) +rxt(k,252))*y(k,103) +rxt(k,24)*y(k,30) & + +.500_r8*rxt(k,242)*y(k,137)*y(k,33) +rxt(k,34)*y(k,69) & + +1.340_r8*rxt(k,36)*y(k,74) +.300_r8*rxt(k,39)*y(k,77) +rxt(k,40) & + *y(k,91) +rxt(k,44)*y(k,107) + loss(k,123) = (rxt(k,144)* y(k,41) +rxt(k,217)* y(k,88) +rxt(k,228)* y(k,126) & + +rxt(k,255)* y(k,127) +rxt(k,238)* y(k,128) + 2._r8*(rxt(k,214) + & + rxt(k,215))* y(k,129) +rxt(k,216)* y(k,132) +rxt(k,300)* y(k,133) & + +rxt(k,274)* y(k,134) +rxt(k,283)* y(k,135) +rxt(k,267)* y(k,139) & + +rxt(k,310)* y(k,140) + het_rates(k,129))* y(k,129) + prod(k,123) = (2.000_r8*rxt(k,237)*y(k,128) +.900_r8*rxt(k,238)*y(k,129) + & + .450_r8*rxt(k,239)*y(k,132) +rxt(k,240)*y(k,88) + & + rxt(k,273)*y(k,134) +rxt(k,282)*y(k,135) +rxt(k,299)*y(k,133) + & + rxt(k,309)*y(k,140))*y(k,128) + (rxt(k,29) +rxt(k,138)*y(k,38) + & + rxt(k,220)*y(k,137) +rxt(k,221)*y(k,136))*y(k,36) & + + (.280_r8*rxt(k,254)*y(k,13) +.050_r8*rxt(k,304)*y(k,71))*y(k,98) & + + (.700_r8*rxt(k,219)*y(k,35) +rxt(k,241)*y(k,32))*y(k,137) & + +rxt(k,59)*y(k,26) +rxt(k,23)*y(k,28) +rxt(k,61)*y(k,29) +rxt(k,24) & + *y(k,30) +rxt(k,26)*y(k,33) +.300_r8*rxt(k,39)*y(k,77) & + +.400_r8*rxt(k,42)*y(k,103) + loss(k,59) = ( + rxt(k,245) + rxt(k,246) + het_rates(k,130))* y(k,130) + prod(k,59) =rxt(k,31)*y(k,51) +.750_r8*rxt(k,244)*y(k,131)*y(k,88) + loss(k,91) = (rxt(k,244)* y(k,88) +rxt(k,243)* y(k,132) + het_rates(k,131)) & + * y(k,131) + prod(k,91) =rxt(k,250)*y(k,137)*y(k,9) + loss(k,130) = (rxt(k,174)* y(k,4) +rxt(k,180)* y(k,6) + (rxt(k,141) + & + rxt(k,142))* y(k,38) +rxt(k,148)* y(k,41) + (rxt(k,97) +rxt(k,98) + & + rxt(k,99))* y(k,54) +rxt(k,296)* y(k,72) +rxt(k,126)* y(k,88) & + +rxt(k,131)* y(k,89) +rxt(k,121)* y(k,90) +rxt(k,101)* y(k,97) & + +rxt(k,102)* y(k,98) +rxt(k,229)* y(k,126) +rxt(k,256)* y(k,127) & + +rxt(k,239)* y(k,128) +rxt(k,216)* y(k,129) +rxt(k,243)* y(k,131) & + + 2._r8*rxt(k,111)* y(k,132) +rxt(k,301)* y(k,133) +rxt(k,275) & + * y(k,134) +rxt(k,284)* y(k,135) +rxt(k,106)* y(k,137) +rxt(k,264) & + * y(k,138) +rxt(k,268)* y(k,139) +rxt(k,311)* y(k,140) + rxt(k,336) & + + het_rates(k,132))* y(k,132) + prod(k,130) = (rxt(k,105)*y(k,57) +rxt(k,108)*y(k,98) +rxt(k,124)*y(k,90) + & + rxt(k,155)*y(k,41) +rxt(k,185)*y(k,6) +rxt(k,197)*y(k,26) + & + rxt(k,200)*y(k,29) +rxt(k,218)*y(k,34) +rxt(k,224)*y(k,44) + & + rxt(k,231)*y(k,10) +rxt(k,247)*y(k,52) +rxt(k,248)*y(k,53) + & + rxt(k,262)*y(k,69) +.200_r8*rxt(k,281)*y(k,75) + & + .500_r8*rxt(k,288)*y(k,76) +rxt(k,308)*y(k,102) + & + rxt(k,323)*y(k,111) +.500_r8*rxt(k,333)*y(k,46))*y(k,137) & + + (rxt(k,144)*y(k,41) +2.000_r8*rxt(k,214)*y(k,129) + & + rxt(k,217)*y(k,88) +rxt(k,228)*y(k,126) + & + .900_r8*rxt(k,238)*y(k,128) +rxt(k,255)*y(k,127) + & + .300_r8*rxt(k,267)*y(k,139) +.730_r8*rxt(k,274)*y(k,134) + & + rxt(k,283)*y(k,135) +rxt(k,300)*y(k,133) + & + .800_r8*rxt(k,310)*y(k,140))*y(k,129) + (rxt(k,230)*y(k,126) + & + .250_r8*rxt(k,244)*y(k,131) +rxt(k,257)*y(k,127) + & + rxt(k,265)*y(k,138) +.470_r8*rxt(k,277)*y(k,134) + & + .794_r8*rxt(k,297)*y(k,72) +.920_r8*rxt(k,302)*y(k,133) + & + rxt(k,312)*y(k,140))*y(k,88) + (rxt(k,211)*y(k,25) + & + .470_r8*rxt(k,276)*y(k,134) +.794_r8*rxt(k,298)*y(k,72) + & + rxt(k,303)*y(k,133) +rxt(k,307)*y(k,102) +rxt(k,313)*y(k,140)) & + *y(k,90) + (.130_r8*rxt(k,226)*y(k,9) +.280_r8*rxt(k,254)*y(k,13) + & + .140_r8*rxt(k,279)*y(k,74) +.280_r8*rxt(k,289)*y(k,77) + & + .370_r8*rxt(k,304)*y(k,71))*y(k,98) + (rxt(k,137)*y(k,25) + & + rxt(k,140)*y(k,57) +rxt(k,196)*y(k,26) +rxt(k,199)*y(k,29))*y(k,38) & + + (.470_r8*rxt(k,273)*y(k,134) +rxt(k,299)*y(k,133) + & + rxt(k,309)*y(k,140))*y(k,128) + (rxt(k,173)*y(k,4) + & + rxt(k,212)*y(k,97))*y(k,25) + (rxt(k,11) +rxt(k,135))*y(k,66) & + + (1.340_r8*rxt(k,36) +.660_r8*rxt(k,37))*y(k,74) + (rxt(k,245) + & + rxt(k,246))*y(k,130) +rxt(k,19)*y(k,11) +rxt(k,20)*y(k,14) +rxt(k,23) & + *y(k,28) +rxt(k,25)*y(k,31) +rxt(k,222)*y(k,136)*y(k,36) & + +2.000_r8*rxt(k,32)*y(k,52) +2.000_r8*rxt(k,33)*y(k,53) +rxt(k,100) & + *y(k,54) +rxt(k,96)*y(k,97)*y(k,57) +rxt(k,34)*y(k,69) +rxt(k,35) & + *y(k,73) +rxt(k,41)*y(k,102) +rxt(k,43)*y(k,106) & + +1.200_r8*rxt(k,227)*y(k,126)*y(k,126) + loss(k,118) = (rxt(k,302)* y(k,88) +rxt(k,303)* y(k,90) +rxt(k,299)* y(k,128) & + +rxt(k,300)* y(k,129) +rxt(k,301)* y(k,132) + het_rates(k,133)) & + * y(k,133) + prod(k,118) = (rxt(k,305)*y(k,71) +.200_r8*rxt(k,306)*y(k,73) + & + 1.640_r8*rxt(k,317)*y(k,122))*y(k,137) +1.700_r8*rxt(k,315)*y(k,122) & + *y(k,90) + loss(k,119) = ((rxt(k,277) +rxt(k,278))* y(k,88) +rxt(k,276)* y(k,90) & + +rxt(k,273)* y(k,128) +rxt(k,274)* y(k,129) +rxt(k,275)* y(k,132) & + + het_rates(k,134))* y(k,134) + prod(k,119) = (.500_r8*rxt(k,280)*y(k,74) +.200_r8*rxt(k,281)*y(k,75) + & + rxt(k,290)*y(k,77))*y(k,137) + loss(k,120) = (rxt(k,286)* y(k,88) +rxt(k,291)* y(k,89) +rxt(k,287)* y(k,90) & + +rxt(k,282)* y(k,128) +rxt(k,283)* y(k,129) +rxt(k,284)* y(k,132) & + + 2._r8*rxt(k,285)* y(k,135) + het_rates(k,135))* y(k,135) + prod(k,120) = (.660_r8*rxt(k,36) +.500_r8*rxt(k,280)*y(k,137))*y(k,74) & + + (rxt(k,38) +rxt(k,292))*y(k,76) +.500_r8*rxt(k,281)*y(k,137) & + *y(k,75) + loss(k,134) = (rxt(k,162)* y(k,16) +rxt(k,163)* y(k,17) +rxt(k,189)* y(k,18) & + +rxt(k,164)* y(k,19) +rxt(k,165)* y(k,20) +rxt(k,166)* y(k,21) & + +rxt(k,167)* y(k,22) +rxt(k,168)* y(k,23) +rxt(k,206)* y(k,24) & + +rxt(k,207)* y(k,26) + (rxt(k,221) +rxt(k,222) +rxt(k,223))* y(k,36) & + +rxt(k,190)* y(k,37) +rxt(k,86)* y(k,55) +rxt(k,191)* y(k,56) & + + (rxt(k,192) +rxt(k,193))* y(k,59) +rxt(k,208)* y(k,60) +rxt(k,209) & + * y(k,61) +rxt(k,210)* y(k,62) + (rxt(k,169) +rxt(k,170))* y(k,63) & + + (rxt(k,129) +rxt(k,130))* y(k,79) + (rxt(k,90) +rxt(k,91)) & + * y(k,98) +rxt(k,87)* y(k,141) + rxt(k,88) + rxt(k,89) & + + het_rates(k,136))* y(k,136) + prod(k,134) =rxt(k,12)*y(k,79) +rxt(k,7)*y(k,98) +rxt(k,1)*y(k,141) + loss(k,135) = (rxt(k,293)* y(k,3) +rxt(k,185)* y(k,6) +rxt(k,250)* y(k,9) & + +rxt(k,231)* y(k,10) +rxt(k,232)* y(k,11) +rxt(k,234)* y(k,12) & + +rxt(k,271)* y(k,13) +rxt(k,258)* y(k,14) +rxt(k,259)* y(k,15) & + +rxt(k,195)* y(k,24) +rxt(k,213)* y(k,25) +rxt(k,197)* y(k,26) & + +rxt(k,198)* y(k,27) +rxt(k,236)* y(k,28) +rxt(k,200)* y(k,29) & + +rxt(k,272)* y(k,30) +rxt(k,261)* y(k,31) +rxt(k,241)* y(k,32) & + +rxt(k,242)* y(k,33) +rxt(k,218)* y(k,34) +rxt(k,219)* y(k,35) & + +rxt(k,220)* y(k,36) +rxt(k,202)* y(k,37) + (rxt(k,155) +rxt(k,156)) & + * y(k,41) +rxt(k,153)* y(k,42) +rxt(k,224)* y(k,44) + (rxt(k,319) + & + rxt(k,333))* y(k,46) +rxt(k,247)* y(k,52) +rxt(k,248)* y(k,53) & + +rxt(k,104)* y(k,55) +rxt(k,105)* y(k,57) +rxt(k,187)* y(k,59) & + +rxt(k,203)* y(k,60) +rxt(k,204)* y(k,61) +rxt(k,205)* y(k,62) & + +rxt(k,158)* y(k,63) +rxt(k,134)* y(k,65) +rxt(k,112)* y(k,66) & + +rxt(k,161)* y(k,68) +rxt(k,262)* y(k,69) +rxt(k,294)* y(k,70) & + +rxt(k,305)* y(k,71) +rxt(k,306)* y(k,73) +rxt(k,280)* y(k,74) & + +rxt(k,281)* y(k,75) +rxt(k,288)* y(k,76) +rxt(k,290)* y(k,77) & + +rxt(k,125)* y(k,78) +rxt(k,335)* y(k,84) +rxt(k,133)* y(k,89) & + +rxt(k,124)* y(k,90) +rxt(k,263)* y(k,91) +rxt(k,107)* y(k,97) & + +rxt(k,108)* y(k,98) +rxt(k,321)* y(k,101) +rxt(k,308)* y(k,102) & + +rxt(k,249)* y(k,103) +rxt(k,266)* y(k,106) +rxt(k,270)* y(k,107) & + +rxt(k,327)* y(k,108) +rxt(k,332)* y(k,110) +rxt(k,323)* y(k,111) & + +rxt(k,317)* y(k,122) +rxt(k,314)* y(k,123) +rxt(k,106)* y(k,132) & + + 2._r8*(rxt(k,109) +rxt(k,110))* y(k,137) + het_rates(k,137)) & + * y(k,137) + prod(k,135) = (2.000_r8*rxt(k,98)*y(k,54) +rxt(k,101)*y(k,97) + & + rxt(k,102)*y(k,98) +rxt(k,121)*y(k,90) +rxt(k,126)*y(k,88) + & + rxt(k,142)*y(k,38) +.450_r8*rxt(k,239)*y(k,128) + & + .150_r8*rxt(k,268)*y(k,139) +.450_r8*rxt(k,284)*y(k,135) + & + .206_r8*rxt(k,296)*y(k,72))*y(k,132) + (rxt(k,95)*y(k,55) + & + rxt(k,96)*y(k,57) +rxt(k,157)*y(k,63) +rxt(k,160)*y(k,68) + & + rxt(k,186)*y(k,59) +rxt(k,188)*y(k,67) +rxt(k,212)*y(k,25))*y(k,97) & + + (rxt(k,103)*y(k,54) +.130_r8*rxt(k,226)*y(k,9) + & + .360_r8*rxt(k,254)*y(k,13) +.240_r8*rxt(k,279)*y(k,74) + & + .360_r8*rxt(k,289)*y(k,77) +.320_r8*rxt(k,304)*y(k,71) + & + 1.156_r8*rxt(k,316)*y(k,122))*y(k,98) + (rxt(k,86)*y(k,55) + & + 2.000_r8*rxt(k,87)*y(k,141) +rxt(k,169)*y(k,63) +rxt(k,192)*y(k,59) + & + rxt(k,221)*y(k,36))*y(k,136) + (.300_r8*rxt(k,219)*y(k,35) + & + .500_r8*rxt(k,232)*y(k,11) +.500_r8*rxt(k,266)*y(k,106) + & + .100_r8*rxt(k,281)*y(k,75) +.500_r8*rxt(k,314)*y(k,123))*y(k,137) & + +rxt(k,19)*y(k,11) +rxt(k,20)*y(k,14) +rxt(k,26)*y(k,33) +rxt(k,27) & + *y(k,35) +.330_r8*rxt(k,28)*y(k,36) +rxt(k,31)*y(k,51) & + +2.000_r8*rxt(k,4)*y(k,57) +rxt(k,9)*y(k,65) +rxt(k,10)*y(k,66) & + +rxt(k,75)*y(k,67) +rxt(k,76)*y(k,68) +.500_r8*rxt(k,339)*y(k,89) & + +rxt(k,43)*y(k,106) +rxt(k,44)*y(k,107) +rxt(k,45)*y(k,123) & + +rxt(k,2)*y(k,141) + loss(k,93) = (rxt(k,265)* y(k,88) +rxt(k,264)* y(k,132) + het_rates(k,138)) & + * y(k,138) + prod(k,93) = (.500_r8*rxt(k,266)*y(k,106) +rxt(k,271)*y(k,13))*y(k,137) + loss(k,108) = (rxt(k,269)* y(k,88) +rxt(k,267)* y(k,129) +rxt(k,268) & + * y(k,132) + het_rates(k,139))* y(k,139) + prod(k,108) = (rxt(k,270)*y(k,107) +rxt(k,272)*y(k,30))*y(k,137) + loss(k,115) = (rxt(k,312)* y(k,88) +rxt(k,313)* y(k,90) +rxt(k,309)* y(k,128) & + +rxt(k,310)* y(k,129) +rxt(k,311)* y(k,132) + het_rates(k,140)) & + * y(k,140) + prod(k,115) = (rxt(k,294)*y(k,70) +.800_r8*rxt(k,306)*y(k,73) + & + .500_r8*rxt(k,314)*y(k,123))*y(k,137) + loss(k,139) = (rxt(k,334)* y(k,112) +rxt(k,87)* y(k,136) + rxt(k,1) & + + rxt(k,2) + rxt(k,3) + het_rates(k,141))* y(k,141) + prod(k,139) = (rxt(k,104)*y(k,55) +rxt(k,105)*y(k,57) +rxt(k,106)*y(k,132) + & + rxt(k,109)*y(k,137) +rxt(k,112)*y(k,66) +rxt(k,134)*y(k,65) + & + rxt(k,158)*y(k,63) +rxt(k,161)*y(k,68) +rxt(k,187)*y(k,59) + & + rxt(k,195)*y(k,24) +rxt(k,197)*y(k,26) +rxt(k,198)*y(k,27) + & + rxt(k,200)*y(k,29) +rxt(k,205)*y(k,62) +rxt(k,213)*y(k,25) + & + rxt(k,219)*y(k,35) +rxt(k,220)*y(k,36) +rxt(k,234)*y(k,12) + & + rxt(k,236)*y(k,28) +rxt(k,241)*y(k,32) +rxt(k,242)*y(k,33) + & + rxt(k,258)*y(k,14) +rxt(k,259)*y(k,15) +rxt(k,261)*y(k,31) + & + rxt(k,266)*y(k,106) +rxt(k,270)*y(k,107) +rxt(k,272)*y(k,30) + & + .500_r8*rxt(k,280)*y(k,74) +rxt(k,335)*y(k,84))*y(k,137) & + + (rxt(k,344)*y(k,68) +rxt(k,350)*y(k,68) +rxt(k,351)*y(k,67) + & + rxt(k,355)*y(k,68) +rxt(k,356)*y(k,67))*y(k,63) + (rxt(k,336) + & + rxt(k,99)*y(k,54))*y(k,132) +.050_r8*rxt(k,28)*y(k,36) +rxt(k,79) & + *y(k,58) + end do + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_rxt_rates_conv.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..e9e70b0ea6 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_rxt_rates_conv.F90 @@ -0,0 +1,375 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 141) ! rate_const*H2O + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 141) ! rate_const*H2O + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 141) ! rate_const*H2O + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 57) ! rate_const*H2O2 + ! rate_const*O2 + ! rate_const*O2 + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 98) ! rate_const*O3 + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 98) ! rate_const*O3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 65) ! rate_const*HNO3 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 66) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 66) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 79) ! rate_const*N2O + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 80) ! rate_const*N2O5 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 80) ! rate_const*N2O5 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 88) ! rate_const*NO + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 89) ! rate_const*NO2 + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 90) ! rate_const*NO3 + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 90) ! rate_const*NO3 + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 11) ! rate_const*C2H5OOH + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 14) ! rate_const*C3H7OOH + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 25) ! rate_const*CH2O + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 25) ! rate_const*CH2O + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 28) ! rate_const*CH3CHO + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 30) ! rate_const*CH3COCH3 + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 31) ! rate_const*CH3COCHO + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 33) ! rate_const*CH3COOOH + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 35) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 36) ! rate_const*CH4 + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 36) ! rate_const*CH4 + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 45) ! rate_const*CO2 + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 51) ! rate_const*EOOH + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 52) ! rate_const*GLYALD + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 53) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 69) ! rate_const*HYAC + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 73) ! rate_const*ISOPOOH + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 74) ! rate_const*MACR + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 74) ! rate_const*MACR + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 76) ! rate_const*MPAN + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 77) ! rate_const*MVK + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 91) ! rate_const*NOA + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 102) ! rate_const*ONITR + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 103) ! rate_const*PAN + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 106) ! rate_const*POOH + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 107) ! rate_const*ROOH + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 123) ! rate_const*XOOH + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 5) ! rate_const*BRCL + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 6) ! rate_const*BRO + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 7) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 7) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 16) ! rate_const*CCL4 + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 17) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 18) ! rate_const*CF3BR + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 19) ! rate_const*CFC11 + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 20) ! rate_const*CFC113 + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 21) ! rate_const*CFC114 + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 22) ! rate_const*CFC115 + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 23) ! rate_const*CFC12 + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 24) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 26) ! rate_const*CH3BR + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 27) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 29) ! rate_const*CH3CL + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 37) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 39) ! rate_const*CL2 + rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 40) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 41) ! rate_const*CLO + rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 42) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 67) = rxt_rates(:ncol,:, 67)*sol(:ncol,:, 42) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 68) = rxt_rates(:ncol,:, 68)*sol(:ncol,:, 56) ! rate_const*H2402 + rxt_rates(:ncol,:, 69) = rxt_rates(:ncol,:, 69)*sol(:ncol,:, 59) ! rate_const*HBR + rxt_rates(:ncol,:, 70) = rxt_rates(:ncol,:, 70)*sol(:ncol,:, 60) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 61) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 62) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 63) ! rate_const*HCL + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 64) ! rate_const*HF + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 67) ! rate_const*HOBR + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 68) ! rate_const*HOCL + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 100) ! rate_const*OCLO + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 109) ! rate_const*SF6 + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 58) ! rate_const*H2SO4 + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 101) ! rate_const*OCS + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 110) ! rate_const*SO + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 111) ! rate_const*SO2 + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 112) ! rate_const*SO3 + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 117) ! rate_const*soa_a1 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 118) ! rate_const*soa_a2 + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 136)*sol(:ncol,:, 55) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 136)*sol(:ncol,:, 141) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 136) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 136) ! rate_const*O2*O1D + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 136)*sol(:ncol,:, 98) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 136)*sol(:ncol,:, 98) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 97)*sol(:ncol,:, 98) ! rate_const*O*O3 + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 97)*sol(:ncol,:, 97) ! rate_const*M*O*O + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 97) ! rate_const*O2*M*O + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 55)*sol(:ncol,:, 97) ! rate_const*H2*O + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 57)*sol(:ncol,:, 97) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 54)*sol(:ncol,:, 132) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 54)*sol(:ncol,:, 132) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 54)*sol(:ncol,:, 132) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 54) ! rate_const*O2*M*H + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 132)*sol(:ncol,:, 97) ! rate_const*HO2*O + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 132)*sol(:ncol,:, 98) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 54)*sol(:ncol,:, 98) ! rate_const*H*O3 + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 137)*sol(:ncol,:, 55) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 137)*sol(:ncol,:, 57) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 137)*sol(:ncol,:, 132) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 137)*sol(:ncol,:, 97) ! rate_const*OH*O + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 137)*sol(:ncol,:, 98) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 137)*sol(:ncol,:, 137) ! rate_const*OH*OH + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 137)*sol(:ncol,:, 137) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 132)*sol(:ncol,:, 132) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 66)*sol(:ncol,:, 137) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 78)*sol(:ncol,:, 88) ! rate_const*N*NO + rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 78)*sol(:ncol,:, 89) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 78)*sol(:ncol,:, 89) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 78)*sol(:ncol,:, 89) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 78) ! rate_const*O2*N + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 89)*sol(:ncol,:, 97) ! rate_const*NO2*O + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 89)*sol(:ncol,:, 98) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 89)*sol(:ncol,:, 97) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 90)*sol(:ncol,:, 132) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 90)*sol(:ncol,:, 88) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 90)*sol(:ncol,:, 97) ! rate_const*NO3*O + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 90)*sol(:ncol,:, 137) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 78)*sol(:ncol,:, 137) ! rate_const*N*OH + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 88)*sol(:ncol,:, 132) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 88)*sol(:ncol,:, 98) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 88)*sol(:ncol,:, 97) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 136)*sol(:ncol,:, 79) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 136)*sol(:ncol,:, 79) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 89)*sol(:ncol,:, 132) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 89)*sol(:ncol,:, 90) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 89)*sol(:ncol,:, 137) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 65)*sol(:ncol,:, 137) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 66) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 80) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 38)*sol(:ncol,:, 25) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 38)*sol(:ncol,:, 36) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 38)*sol(:ncol,:, 55) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 38)*sol(:ncol,:, 57) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 38)*sol(:ncol,:, 132) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 38)*sol(:ncol,:, 132) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 38)*sol(:ncol,:, 98) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 41)*sol(:ncol,:, 129) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 41)*sol(:ncol,:, 41) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 41)*sol(:ncol,:, 41) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 41)*sol(:ncol,:, 41) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 41)*sol(:ncol,:, 132) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 41)*sol(:ncol,:, 88) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 42)*sol(:ncol,:, 38) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 41)*sol(:ncol,:, 89) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 42)*sol(:ncol,:, 97) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 42)*sol(:ncol,:, 137) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 41)*sol(:ncol,:, 97) ! rate_const*CLO*O + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 41)*sol(:ncol,:, 137) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 41)*sol(:ncol,:, 137) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 63)*sol(:ncol,:, 97) ! rate_const*HCL*O + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 63)*sol(:ncol,:, 137) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 68)*sol(:ncol,:, 38) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 68)*sol(:ncol,:, 97) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 68)*sol(:ncol,:, 137) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 136)*sol(:ncol,:, 16) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 136)*sol(:ncol,:, 17) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 136)*sol(:ncol,:, 19) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 136)*sol(:ncol,:, 20) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 136)*sol(:ncol,:, 21) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 136)*sol(:ncol,:, 22) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 136)*sol(:ncol,:, 23) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 136)*sol(:ncol,:, 63) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 136)*sol(:ncol,:, 63) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 41)*sol(:ncol,:, 41) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 40) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 4)*sol(:ncol,:, 25) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 4)*sol(:ncol,:, 132) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 4)*sol(:ncol,:, 98) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 6)*sol(:ncol,:, 6) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 6)*sol(:ncol,:, 41) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 6)*sol(:ncol,:, 41) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 6)*sol(:ncol,:, 41) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 6)*sol(:ncol,:, 132) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 6)*sol(:ncol,:, 88) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 6)*sol(:ncol,:, 89) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 7)*sol(:ncol,:, 97) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 6)*sol(:ncol,:, 97) ! rate_const*BRO*O + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 6)*sol(:ncol,:, 137) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 59)*sol(:ncol,:, 97) ! rate_const*HBR*O + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 59)*sol(:ncol,:, 137) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 67)*sol(:ncol,:, 97) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 136)*sol(:ncol,:, 18) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 136)*sol(:ncol,:, 37) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 136)*sol(:ncol,:, 56) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 136)*sol(:ncol,:, 59) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 136)*sol(:ncol,:, 59) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 24)*sol(:ncol,:, 38) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 24)*sol(:ncol,:, 137) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 26)*sol(:ncol,:, 38) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 26)*sol(:ncol,:, 137) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 27)*sol(:ncol,:, 137) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 29)*sol(:ncol,:, 38) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 29)*sol(:ncol,:, 137) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 37)*sol(:ncol,:, 38) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 37)*sol(:ncol,:, 137) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 60)*sol(:ncol,:, 137) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 61)*sol(:ncol,:, 137) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 62)*sol(:ncol,:, 137) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 136)*sol(:ncol,:, 24) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 136)*sol(:ncol,:, 26) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 136)*sol(:ncol,:, 60) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 136)*sol(:ncol,:, 61) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 136)*sol(:ncol,:, 62) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 25)*sol(:ncol,:, 90) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 25)*sol(:ncol,:, 97) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 25)*sol(:ncol,:, 137) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 129)*sol(:ncol,:, 129) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 129)*sol(:ncol,:, 129) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 129)*sol(:ncol,:, 132) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 129)*sol(:ncol,:, 88) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 34)*sol(:ncol,:, 137) ! rate_const*CH3OH*OH + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 35)*sol(:ncol,:, 137) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 36)*sol(:ncol,:, 137) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 136)*sol(:ncol,:, 36) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 136)*sol(:ncol,:, 36) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 136)*sol(:ncol,:, 36) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 44)*sol(:ncol,:, 137) ! rate_const*CO*OH + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 9)*sol(:ncol,:, 38) ! rate_const*M*C2H4*CL + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 9)*sol(:ncol,:, 98) ! rate_const*C2H4*O3 + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 126)*sol(:ncol,:, 126) ! rate_const*C2H5O2*C2H5O2 + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 126)*sol(:ncol,:, 129) ! rate_const*C2H5O2*CH3O2 + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 126)*sol(:ncol,:, 132) ! rate_const*C2H5O2*HO2 + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 126)*sol(:ncol,:, 88) ! rate_const*C2H5O2*NO + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 10)*sol(:ncol,:, 137) ! rate_const*C2H5OH*OH + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 11)*sol(:ncol,:, 137) ! rate_const*C2H5OOH*OH + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 12)*sol(:ncol,:, 38) ! rate_const*C2H6*CL + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 12)*sol(:ncol,:, 137) ! rate_const*C2H6*OH + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 28)*sol(:ncol,:, 90) ! rate_const*CH3CHO*NO3 + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 28)*sol(:ncol,:, 137) ! rate_const*CH3CHO*OH + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 128)*sol(:ncol,:, 128) ! rate_const*CH3CO3*CH3CO3 + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 128)*sol(:ncol,:, 129) ! rate_const*CH3CO3*CH3O2 + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 128)*sol(:ncol,:, 132) ! rate_const*CH3CO3*HO2 + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 128)*sol(:ncol,:, 88) ! rate_const*CH3CO3*NO + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 32)*sol(:ncol,:, 137) ! rate_const*CH3COOH*OH + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 33)*sol(:ncol,:, 137) ! rate_const*CH3COOOH*OH + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 131)*sol(:ncol,:, 132) ! rate_const*EO2*HO2 + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 131)*sol(:ncol,:, 88) ! rate_const*EO2*NO + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 130) ! rate_const*EO + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 130) ! rate_const*O2*EO + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 52)*sol(:ncol,:, 137) ! rate_const*GLYALD*OH + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 53)*sol(:ncol,:, 137) ! rate_const*GLYOXAL*OH + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 103)*sol(:ncol,:, 137) ! rate_const*PAN*OH + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 9)*sol(:ncol,:, 137) ! rate_const*M*C2H4*OH + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 128)*sol(:ncol,:, 89) ! rate_const*M*CH3CO3*NO2 + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 103) ! rate_const*M*PAN + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 13)*sol(:ncol,:, 90) ! rate_const*C3H6*NO3 + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 13)*sol(:ncol,:, 98) ! rate_const*C3H6*O3 + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 127)*sol(:ncol,:, 129) ! rate_const*C3H7O2*CH3O2 + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 127)*sol(:ncol,:, 132) ! rate_const*C3H7O2*HO2 + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 127)*sol(:ncol,:, 88) ! rate_const*C3H7O2*NO + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 14)*sol(:ncol,:, 137) ! rate_const*C3H7OOH*OH + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 15)*sol(:ncol,:, 137) ! rate_const*C3H8*OH + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 31)*sol(:ncol,:, 90) ! rate_const*CH3COCHO*NO3 + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 31)*sol(:ncol,:, 137) ! rate_const*CH3COCHO*OH + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 69)*sol(:ncol,:, 137) ! rate_const*HYAC*OH + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 91)*sol(:ncol,:, 137) ! rate_const*NOA*OH + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 138)*sol(:ncol,:, 132) ! rate_const*PO2*HO2 + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 138)*sol(:ncol,:, 88) ! rate_const*PO2*NO + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 106)*sol(:ncol,:, 137) ! rate_const*POOH*OH + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 139)*sol(:ncol,:, 129) ! rate_const*RO2*CH3O2 + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 139)*sol(:ncol,:, 132) ! rate_const*RO2*HO2 + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 139)*sol(:ncol,:, 88) ! rate_const*RO2*NO + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 107)*sol(:ncol,:, 137) ! rate_const*ROOH*OH + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 13)*sol(:ncol,:, 137) ! rate_const*M*C3H6*OH + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 30)*sol(:ncol,:, 137) ! rate_const*CH3COCH3*OH + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 134)*sol(:ncol,:, 128) ! rate_const*MACRO2*CH3CO3 + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 134)*sol(:ncol,:, 129) ! rate_const*MACRO2*CH3O2 + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 134)*sol(:ncol,:, 132) ! rate_const*MACRO2*HO2 + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 134)*sol(:ncol,:, 90) ! rate_const*MACRO2*NO3 + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 134)*sol(:ncol,:, 88) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 134)*sol(:ncol,:, 88) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 74)*sol(:ncol,:, 98) ! rate_const*MACR*O3 + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 74)*sol(:ncol,:, 137) ! rate_const*MACR*OH + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 75)*sol(:ncol,:, 137) ! rate_const*MACROOH*OH + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 135)*sol(:ncol,:, 128) ! rate_const*MCO3*CH3CO3 + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 135)*sol(:ncol,:, 129) ! rate_const*MCO3*CH3O2 + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 135)*sol(:ncol,:, 132) ! rate_const*MCO3*HO2 + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 135)*sol(:ncol,:, 135) ! rate_const*MCO3*MCO3 + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 135)*sol(:ncol,:, 88) ! rate_const*MCO3*NO + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 135)*sol(:ncol,:, 90) ! rate_const*MCO3*NO3 + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 76)*sol(:ncol,:, 137) ! rate_const*M*MPAN*OH + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 77)*sol(:ncol,:, 98) ! rate_const*MVK*O3 + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 77)*sol(:ncol,:, 137) ! rate_const*MVK*OH + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 135)*sol(:ncol,:, 89) ! rate_const*M*MCO3*NO2 + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 76) ! rate_const*M*MPAN + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 3)*sol(:ncol,:, 137) ! rate_const*BIGALK*OH + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 70)*sol(:ncol,:, 137) ! rate_const*HYDRALD*OH + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 71)*sol(:ncol,:, 90) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 72)*sol(:ncol,:, 132) ! rate_const*ISOPNO3*HO2 + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 72)*sol(:ncol,:, 88) ! rate_const*ISOPNO3*NO + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 72)*sol(:ncol,:, 90) ! rate_const*ISOPNO3*NO3 + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 133)*sol(:ncol,:, 128) ! rate_const*ISOPO2*CH3CO3 + rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 133)*sol(:ncol,:, 129) ! rate_const*ISOPO2*CH3O2 + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 133)*sol(:ncol,:, 132) ! rate_const*ISOPO2*HO2 + rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 133)*sol(:ncol,:, 88) ! rate_const*ISOPO2*NO + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 133)*sol(:ncol,:, 90) ! rate_const*ISOPO2*NO3 + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 71)*sol(:ncol,:, 98) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 71)*sol(:ncol,:, 137) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 73)*sol(:ncol,:, 137) ! rate_const*ISOPOOH*OH + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 102)*sol(:ncol,:, 90) ! rate_const*ONITR*NO3 + rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 102)*sol(:ncol,:, 137) ! rate_const*ONITR*OH + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 140)*sol(:ncol,:, 128) ! rate_const*XO2*CH3CO3 + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 140)*sol(:ncol,:, 129) ! rate_const*XO2*CH3O2 + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 140)*sol(:ncol,:, 132) ! rate_const*XO2*HO2 + rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 140)*sol(:ncol,:, 88) ! rate_const*XO2*NO + rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 140)*sol(:ncol,:, 90) ! rate_const*XO2*NO3 + rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 123)*sol(:ncol,:, 137) ! rate_const*XOOH*OH + rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 122)*sol(:ncol,:, 90) ! rate_const*TERP*NO3 + rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 122)*sol(:ncol,:, 98) ! rate_const*TERP*O3 + rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 122)*sol(:ncol,:, 137) ! rate_const*TERP*OH + rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 46)*sol(:ncol,:, 90) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 46)*sol(:ncol,:, 137) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 101)*sol(:ncol,:, 97) ! rate_const*OCS*O + rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 101)*sol(:ncol,:, 137) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 108) ! rate_const*O2*S + rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 111)*sol(:ncol,:, 137) ! rate_const*M*SO2*OH + rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 108)*sol(:ncol,:, 98) ! rate_const*S*O3 + rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 110)*sol(:ncol,:, 6) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 110)*sol(:ncol,:, 41) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 108)*sol(:ncol,:, 137) ! rate_const*S*OH + rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 110)*sol(:ncol,:, 89) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 110) ! rate_const*O2*SO + rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 110)*sol(:ncol,:, 98) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 110)*sol(:ncol,:, 100) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 110)*sol(:ncol,:, 137) ! rate_const*SO*OH + rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 46)*sol(:ncol,:, 137) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 112)*sol(:ncol,:, 141) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 84)*sol(:ncol,:, 137) ! rate_const*NH3*OH + rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 132) ! rate_const*HO2 + rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 80) ! rate_const*N2O5 + rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 85) ! rate_const*NH4 + rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 89) ! rate_const*NO2 + rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 90) ! rate_const*NO3 + rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 102) ! rate_const*ONITR + rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 119) ! rate_const*SOAE + rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 80) ! rate_const*N2O5 + rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 68)*sol(:ncol,:, 63) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 7) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 80) ! rate_const*N2O5 + rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 42) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 7) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 42)*sol(:ncol,:, 63) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 68)*sol(:ncol,:, 63) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 67)*sol(:ncol,:, 63) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 42) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 7) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 42)*sol(:ncol,:, 63) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 68)*sol(:ncol,:, 63) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 67)*sol(:ncol,:, 63) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 80) ! rate_const*N2O5 + rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 42) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 42)*sol(:ncol,:, 63) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 50) ! rate_const*E90 + rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 87) ! rate_const*NH_50 + rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 86) ! rate_const*NH_5 + rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 121) ! rate_const*ST80_25 + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_setrxt.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_setrxt.F90 new file mode 100644 index 0000000000..781067fcc2 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_setrxt.F90 @@ -0,0 +1,454 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pcols, pver + + + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol*pver) + real(r8), intent(inout) :: rate(ncol*pver,max(1,rxntot)) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + integer :: offset + real(r8) :: itemp(ncol*pver) + real(r8) :: exp_fac(ncol*pver) + real(r8) :: ko(ncol*pver) + real(r8) :: kinf(ncol*pver) + + rate(:,86) = 1.2e-10_r8 + rate(:,90) = 1.2e-10_r8 + rate(:,91) = 1.2e-10_r8 + rate(:,97) = 6.9e-12_r8 + rate(:,98) = 7.2e-11_r8 + rate(:,99) = 1.6e-12_r8 + rate(:,105) = 1.8e-12_r8 + rate(:,109) = 1.8e-12_r8 + rate(:,121) = 3.5e-12_r8 + rate(:,123) = 1.3e-11_r8 + rate(:,124) = 2.2e-11_r8 + rate(:,125) = 5e-11_r8 + rate(:,160) = 1.7e-13_r8 + rate(:,162) = 2.607e-10_r8 + rate(:,163) = 9.75e-11_r8 + rate(:,164) = 2.07e-10_r8 + rate(:,165) = 2.088e-10_r8 + rate(:,166) = 1.17e-10_r8 + rate(:,167) = 4.644e-11_r8 + rate(:,168) = 1.204e-10_r8 + rate(:,169) = 9.9e-11_r8 + rate(:,170) = 3.3e-12_r8 + rate(:,189) = 4.5e-11_r8 + rate(:,190) = 4.62e-10_r8 + rate(:,191) = 1.2e-10_r8 + rate(:,192) = 9e-11_r8 + rate(:,193) = 3e-11_r8 + rate(:,206) = 2.57e-10_r8 + rate(:,207) = 1.8e-10_r8 + rate(:,208) = 1.794e-10_r8 + rate(:,209) = 1.3e-10_r8 + rate(:,210) = 7.65e-11_r8 + rate(:,221) = 1.31e-10_r8 + rate(:,222) = 3.5e-11_r8 + rate(:,223) = 9e-12_r8 + rate(:,227) = 6.8e-14_r8 + rate(:,228) = 2e-13_r8 + rate(:,242) = 1e-12_r8 + rate(:,246) = 1e-14_r8 + rate(:,247) = 1e-11_r8 + rate(:,248) = 1.15e-11_r8 + rate(:,249) = 4e-14_r8 + rate(:,262) = 3e-12_r8 + rate(:,263) = 6.7e-13_r8 + rate(:,273) = 1.4e-11_r8 + rate(:,276) = 2.4e-12_r8 + rate(:,287) = 5e-12_r8 + rate(:,293) = 3.5e-12_r8 + rate(:,298) = 2.4e-12_r8 + rate(:,299) = 1.4e-11_r8 + rate(:,303) = 2.4e-12_r8 + rate(:,308) = 4.5e-11_r8 + rate(:,313) = 2.4e-12_r8 + rate(:,322) = 2.3e-12_r8 + rate(:,324) = 1.2e-11_r8 + rate(:,325) = 5.7e-11_r8 + rate(:,326) = 2.8e-11_r8 + rate(:,327) = 6.6e-11_r8 + rate(:,328) = 1.4e-11_r8 + rate(:,331) = 1.9e-12_r8 + rate(:,338) = 6.34e-08_r8 + rate(:,342) = 1.157e-05_r8 + rate(:,360) = 1.29e-07_r8 + rate(:,361) = 2.31e-07_r8 + rate(:,362) = 2.31e-06_r8 + rate(:,363) = 4.63e-07_r8 + + do n = 1,pver + offset = (n-1)*ncol + itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,n) + end do + + rate(:,87) = 1.63e-10_r8 * exp( 60._r8 * itemp(:) ) + rate(:,88) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + rate(:,89) = 3.3e-11_r8 * exp( 55._r8 * itemp(:) ) + rate(:,92) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:,95) = 1.6e-11_r8 * exp( -4570._r8 * itemp(:) ) + exp_fac(:) = exp( -2000._r8 * itemp(:) ) + rate(:,96) = 1.4e-12_r8 * exp_fac(:) + rate(:,304) = 1.05e-14_r8 * exp_fac(:) + exp_fac(:) = exp( 200._r8 * itemp(:) ) + rate(:,101) = 3e-11_r8 * exp_fac(:) + rate(:,187) = 5.5e-12_r8 * exp_fac(:) + rate(:,219) = 3.8e-12_r8 * exp_fac(:) + rate(:,232) = 3.8e-12_r8 * exp_fac(:) + rate(:,258) = 3.8e-12_r8 * exp_fac(:) + rate(:,266) = 3.8e-12_r8 * exp_fac(:) + rate(:,270) = 3.8e-12_r8 * exp_fac(:) + rate(:,281) = 2.3e-11_r8 * exp_fac(:) + rate(:,306) = 1.52e-11_r8 * exp_fac(:) + rate(:,314) = 1.52e-12_r8 * exp_fac(:) + rate(:,102) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:,103) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:,104) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:) ) + exp_fac(:) = exp( 250._r8 * itemp(:) ) + rate(:,106) = 4.8e-11_r8 * exp_fac(:) + rate(:,185) = 1.7e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 180._r8 * itemp(:) ) + rate(:,107) = 1.8e-11_r8 * exp_fac(:) + rate(:,244) = 4.2e-12_r8 * exp_fac(:) + rate(:,257) = 4.2e-12_r8 * exp_fac(:) + rate(:,265) = 4.2e-12_r8 * exp_fac(:) + rate(:,302) = 4.4e-12_r8 * exp_fac(:) + rate(:,108) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:,112) = 4.5e-13_r8 * exp( 610._r8 * itemp(:) ) + rate(:,113) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + exp_fac(:) = exp( 220._r8 * itemp(:) ) + rate(:,114) = 2.9e-12_r8 * exp_fac(:) + rate(:,115) = 1.45e-12_r8 * exp_fac(:) + rate(:,116) = 1.45e-12_r8 * exp_fac(:) + rate(:,117) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:,118) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + exp_fac(:) = exp( -2450._r8 * itemp(:) ) + rate(:,119) = 1.2e-13_r8 * exp_fac(:) + rate(:,145) = 3e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 125._r8 * itemp(:) ) + rate(:,122) = 1.7e-11_r8 * exp_fac(:) + rate(:,213) = 5.5e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 260._r8 * itemp(:) ) + rate(:,126) = 3.44e-12_r8 * exp_fac(:) + rate(:,178) = 2.3e-12_r8 * exp_fac(:) + rate(:,181) = 8.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -1500._r8 * itemp(:) ) + rate(:,127) = 3e-12_r8 * exp_fac(:) + rate(:,186) = 5.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 20._r8 * itemp(:) ) + rate(:,129) = 7.26e-11_r8 * exp_fac(:) + rate(:,130) = 4.64e-11_r8 * exp_fac(:) + rate(:,137) = 8.1e-11_r8 * exp( -30._r8 * itemp(:) ) + rate(:,138) = 7.1e-12_r8 * exp( -1270._r8 * itemp(:) ) + rate(:,139) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) + rate(:,140) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) + exp_fac(:) = exp( 270._r8 * itemp(:) ) + rate(:,141) = 1.4e-11_r8 * exp_fac(:) + rate(:,155) = 7.4e-12_r8 * exp_fac(:) + rate(:,240) = 8.1e-12_r8 * exp_fac(:) + rate(:,142) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) + rate(:,143) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) + rate(:,144) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) + rate(:,146) = 1e-12_r8 * exp( -1590._r8 * itemp(:) ) + rate(:,147) = 3.5e-13_r8 * exp( -1370._r8 * itemp(:) ) + exp_fac(:) = exp( 290._r8 * itemp(:) ) + rate(:,148) = 2.6e-12_r8 * exp_fac(:) + rate(:,149) = 6.4e-12_r8 * exp_fac(:) + rate(:,179) = 4.1e-13_r8 * exp_fac(:) + rate(:,150) = 6.5e-12_r8 * exp( 135._r8 * itemp(:) ) + exp_fac(:) = exp( -840._r8 * itemp(:) ) + rate(:,152) = 3.6e-12_r8 * exp_fac(:) + rate(:,195) = 2e-12_r8 * exp_fac(:) + rate(:,153) = 1.2e-12_r8 * exp( -330._r8 * itemp(:) ) + rate(:,154) = 2.8e-11_r8 * exp( 85._r8 * itemp(:) ) + exp_fac(:) = exp( 230._r8 * itemp(:) ) + rate(:,156) = 6e-13_r8 * exp_fac(:) + rate(:,176) = 1.5e-12_r8 * exp_fac(:) + rate(:,184) = 1.9e-11_r8 * exp_fac(:) + rate(:,157) = 1e-11_r8 * exp( -3300._r8 * itemp(:) ) + rate(:,158) = 1.8e-12_r8 * exp( -250._r8 * itemp(:) ) + rate(:,159) = 3.4e-12_r8 * exp( -130._r8 * itemp(:) ) + rate(:,161) = 3e-12_r8 * exp( -500._r8 * itemp(:) ) + exp_fac(:) = exp( -800._r8 * itemp(:) ) + rate(:,173) = 1.7e-11_r8 * exp_fac(:) + rate(:,194) = 6.3e-12_r8 * exp_fac(:) + rate(:,174) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) + rate(:,175) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) + rate(:,177) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) + rate(:,180) = 4.5e-12_r8 * exp( 460._r8 * itemp(:) ) + rate(:,183) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) + rate(:,188) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) + rate(:,196) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:) ) + rate(:,197) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:) ) + exp_fac(:) = exp( -1520._r8 * itemp(:) ) + rate(:,198) = 1.64e-12_r8 * exp_fac(:) + rate(:,289) = 8.5e-16_r8 * exp_fac(:) + exp_fac(:) = exp( -1100._r8 * itemp(:) ) + rate(:,199) = 2.03e-11_r8 * exp_fac(:) + rate(:,330) = 3.4e-12_r8 * exp_fac(:) + rate(:,200) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:) ) + rate(:,201) = 4.85e-12_r8 * exp( -850._r8 * itemp(:) ) + rate(:,202) = 9e-13_r8 * exp( -360._r8 * itemp(:) ) + exp_fac(:) = exp( -1600._r8 * itemp(:) ) + rate(:,203) = 1.25e-12_r8 * exp_fac(:) + rate(:,212) = 3.4e-11_r8 * exp_fac(:) + rate(:,204) = 1.3e-12_r8 * exp( -1770._r8 * itemp(:) ) + rate(:,205) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) + rate(:,211) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) + rate(:,214) = 5e-13_r8 * exp( -424._r8 * itemp(:) ) + rate(:,215) = 1.9e-14_r8 * exp( 706._r8 * itemp(:) ) + rate(:,216) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) + exp_fac(:) = exp( 300._r8 * itemp(:) ) + rate(:,217) = 2.8e-12_r8 * exp_fac(:) + rate(:,269) = 2.9e-12_r8 * exp_fac(:) + rate(:,218) = 2.9e-12_r8 * exp( -345._r8 * itemp(:) ) + rate(:,220) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) + rate(:,226) = 1.2e-14_r8 * exp( -2630._r8 * itemp(:) ) + exp_fac(:) = exp( 700._r8 * itemp(:) ) + rate(:,229) = 7.5e-13_r8 * exp_fac(:) + rate(:,243) = 7.5e-13_r8 * exp_fac(:) + rate(:,256) = 7.5e-13_r8 * exp_fac(:) + rate(:,264) = 7.5e-13_r8 * exp_fac(:) + rate(:,268) = 8.6e-13_r8 * exp_fac(:) + rate(:,275) = 8e-13_r8 * exp_fac(:) + rate(:,296) = 8e-13_r8 * exp_fac(:) + rate(:,301) = 8e-13_r8 * exp_fac(:) + rate(:,311) = 8e-13_r8 * exp_fac(:) + rate(:,230) = 2.6e-12_r8 * exp( 365._r8 * itemp(:) ) + rate(:,231) = 6.9e-12_r8 * exp( -230._r8 * itemp(:) ) + rate(:,233) = 7.2e-11_r8 * exp( -70._r8 * itemp(:) ) + rate(:,234) = 7.66e-12_r8 * exp( -1020._r8 * itemp(:) ) + exp_fac(:) = exp( -1900._r8 * itemp(:) ) + rate(:,235) = 1.4e-12_r8 * exp_fac(:) + rate(:,254) = 6.5e-15_r8 * exp_fac(:) + rate(:,236) = 4.63e-12_r8 * exp( 350._r8 * itemp(:) ) + exp_fac(:) = exp( 500._r8 * itemp(:) ) + rate(:,237) = 2.9e-12_r8 * exp_fac(:) + rate(:,238) = 2e-12_r8 * exp_fac(:) + rate(:,267) = 7.1e-13_r8 * exp_fac(:) + rate(:,283) = 2e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 1040._r8 * itemp(:) ) + rate(:,239) = 4.3e-13_r8 * exp_fac(:) + rate(:,284) = 4.3e-13_r8 * exp_fac(:) + rate(:,241) = 3.15e-14_r8 * exp( 920._r8 * itemp(:) ) + rate(:,245) = 1.6e+11_r8 * exp( -4150._r8 * itemp(:) ) + rate(:,253) = 4.6e-13_r8 * exp( -1156._r8 * itemp(:) ) + rate(:,255) = 3.75e-13_r8 * exp( -40._r8 * itemp(:) ) + rate(:,259) = 9.19e-12_r8 * exp( -630._r8 * itemp(:) ) + exp_fac(:) = exp( -1860._r8 * itemp(:) ) + rate(:,260) = 1.4e-12_r8 * exp_fac(:) + rate(:,307) = 1.4e-12_r8 * exp_fac(:) + rate(:,261) = 8.4e-13_r8 * exp( 830._r8 * itemp(:) ) + exp_fac(:) = exp( 400._r8 * itemp(:) ) + rate(:,274) = 5e-13_r8 * exp_fac(:) + rate(:,300) = 5e-13_r8 * exp_fac(:) + rate(:,310) = 5e-13_r8 * exp_fac(:) + exp_fac(:) = exp( 360._r8 * itemp(:) ) + rate(:,277) = 2.7e-12_r8 * exp_fac(:) + rate(:,278) = 1.3e-13_r8 * exp_fac(:) + rate(:,280) = 9.6e-12_r8 * exp_fac(:) + rate(:,286) = 5.3e-12_r8 * exp_fac(:) + rate(:,297) = 2.7e-12_r8 * exp_fac(:) + rate(:,312) = 2.7e-12_r8 * exp_fac(:) + rate(:,279) = 1.5e-15_r8 * exp( -2100._r8 * itemp(:) ) + exp_fac(:) = exp( 530._r8 * itemp(:) ) + rate(:,282) = 4.6e-12_r8 * exp_fac(:) + rate(:,285) = 2.3e-12_r8 * exp_fac(:) + rate(:,290) = 4.13e-12_r8 * exp( 452._r8 * itemp(:) ) + rate(:,294) = 1.86e-11_r8 * exp( 175._r8 * itemp(:) ) + rate(:,295) = 3.03e-12_r8 * exp( -446._r8 * itemp(:) ) + rate(:,305) = 2.54e-11_r8 * exp( 410._r8 * itemp(:) ) + rate(:,309) = 1.3e-12_r8 * exp( 640._r8 * itemp(:) ) + rate(:,315) = 1.2e-12_r8 * exp( 490._r8 * itemp(:) ) + rate(:,316) = 6.3e-16_r8 * exp( -580._r8 * itemp(:) ) + rate(:,317) = 1.2e-11_r8 * exp( 440._r8 * itemp(:) ) + rate(:,318) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) + rate(:,319) = 1.1e-11_r8 * exp( -280._r8 * itemp(:) ) + rate(:,320) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) + rate(:,321) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) + rate(:,329) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) + rate(:,332) = 2.6e-11_r8 * exp( 330._r8 * itemp(:) ) + rate(:,335) = 1.7e-12_r8 * exp( -710._r8 * itemp(:) ) + + itemp(:) = 300._r8 * itemp(:) + + n = ncol*pver + + ko(:) = 5.3e-32_r8 * itemp(:)**1.8_r8 + kinf(:) = 9.5e-11_r8 * itemp(:)**(-0.4_r8) + call jpl( rate(:,100), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 6.9e-31_r8 * itemp(:)**1._r8 + kinf(:) = 2.6e-11_r8 + call jpl( rate(:,110), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 2.5e-31_r8 * itemp(:)**1.8_r8 + kinf(:) = 2.2e-11_r8 * itemp(:)**0.7_r8 + call jpl( rate(:,120), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9e-32_r8 * itemp(:)**1.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,128), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.9e-31_r8 * itemp(:)**3.4_r8 + kinf(:) = 4e-12_r8 * itemp(:)**0.3_r8 + call jpl( rate(:,131), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 2.4e-30_r8 * itemp(:)**3._r8 + kinf(:) = 1.6e-12_r8 * itemp(:)**(-0.1_r8) + call jpl( rate(:,132), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.8e-30_r8 * itemp(:)**3._r8 + kinf(:) = 2.8e-11_r8 + call jpl( rate(:,133), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.8e-31_r8 * itemp(:)**3.4_r8 + kinf(:) = 1.5e-11_r8 * itemp(:)**1.9_r8 + call jpl( rate(:,151), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.9e-32_r8 * itemp(:)**3.6_r8 + kinf(:) = 3.7e-12_r8 * itemp(:)**1.6_r8 + call jpl( rate(:,171), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 5.2e-31_r8 * itemp(:)**3.2_r8 + kinf(:) = 6.9e-12_r8 * itemp(:)**2.9_r8 + call jpl( rate(:,182), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.6e-29_r8 * itemp(:)**3.3_r8 + kinf(:) = 3.1e-10_r8 * itemp(:) + call jpl( rate(:,225), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 8.6e-29_r8 * itemp(:)**3.1_r8 + kinf(:) = 9e-12_r8 * itemp(:)**0.85_r8 + call jpl( rate(:,250), m, 0.48_r8, ko, kinf, n ) + + ko(:) = 7.3e-29_r8 * itemp(:)**4.1_r8 + kinf(:) = 9.5e-12_r8 * itemp(:)**1.6_r8 + call jpl( rate(:,251), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,271), m, 0.5_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,288), m, 0.5_r8, ko, kinf, n ) + + ko(:) = 9.7e-29_r8 * itemp(:)**5.6_r8 + kinf(:) = 9.3e-12_r8 * itemp(:)**1.5_r8 + call jpl( rate(:,291), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 2.9e-31_r8 * itemp(:)**4.1_r8 + kinf(:) = 1.7e-12_r8 * itemp(:)**(-0.2_r8) + call jpl( rate(:,323), m, 0.6_r8, ko, kinf, n ) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pcols, pver + + + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol*pver) + real(r8), intent(inout) :: rate(ncol*pver,max(1,rxntot)) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + integer :: offset + integer :: k + real(r8) :: itemp(ncol*kbot) + real(r8) :: exp_fac(ncol*kbot) + real(r8) :: ko(ncol*kbot) + real(r8) :: kinf(ncol*kbot) + real(r8) :: wrk(ncol*kbot) + + n = ncol*kbot + + rate(:n,97) = 6.9e-12_r8 + + do k = 1,kbot + offset = (k-1)*ncol + itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,k) + end do + + rate(:n,88) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + rate(:n,92) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:n,101) = 3e-11_r8 * exp( 200._r8 * itemp(:) ) + rate(:n,102) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:n,103) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:n,106) = 4.8e-11_r8 * exp( 250._r8 * itemp(:) ) + rate(:n,107) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) + rate(:n,108) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:n,113) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + rate(:n,117) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:n,118) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + rate(:n,126) = 3.44e-12_r8 * exp( 260._r8 * itemp(:) ) + rate(:n,127) = 3e-12_r8 * exp( -1500._r8 * itemp(:) ) + + itemp(:) = 300._r8 * itemp(:) + + ko(:) = 5.3e-32_r8 * itemp(:)**1.8_r8 + kinf(:) = 9.5e-11_r8 * itemp(:)**(-0.4_r8) + call jpl( wrk, m, 0.6_r8, ko, kinf, n ) + rate(:n,100) = wrk(:) + + + + + + + + + + + + + + + + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_sim_dat.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_sim_dat.F90 new file mode 100644 index 0000000000..b70148648c --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_sim_dat.F90 @@ -0,0 +1,572 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .false. + is_vector = .true. + + clscnt(:) = (/ 2, 0, 0, 139, 0 /) + + cls_rxt_cnt(:,1) = (/ 3, 0, 0, 2 /) + cls_rxt_cnt(:,4) = (/ 2, 117, 244, 139 /) + + solsym(:141) = (/ 'bc_a1 ','bc_a4 ','BIGALK ','BR ','BRCL ', & + 'BRO ','BRONO2 ','BRY ','C2H4 ','C2H5OH ', & + 'C2H5OOH ','C2H6 ','C3H6 ','C3H7OOH ','C3H8 ', & + 'CCL4 ','CF2CLBR ','CF3BR ','CFC11 ','CFC113 ', & + 'CFC114 ','CFC115 ','CFC12 ','CH2BR2 ','CH2O ', & + 'CH3BR ','CH3CCL3 ','CH3CHO ','CH3CL ','CH3COCH3 ', & + 'CH3COCHO ','CH3COOH ','CH3COOOH ','CH3OH ','CH3OOH ', & + 'CH4 ','CHBR3 ','CL ','CL2 ','CL2O2 ', & + 'CLO ','CLONO2 ','CLY ','CO ','CO2 ', & + 'DMS ','dst_a1 ','dst_a2 ','dst_a3 ','E90 ', & + 'EOOH ','GLYALD ','GLYOXAL ','H ','H2 ', & + 'H2402 ','H2O2 ','H2SO4 ','HBR ','HCFC141B ', & + 'HCFC142B ','HCFC22 ','HCL ','HF ','HNO3 ', & + 'HO2NO2 ','HOBR ','HOCL ','HYAC ','HYDRALD ', & + 'ISOP ','ISOPNO3 ','ISOPOOH ','MACR ','MACROOH ', & + 'MPAN ','MVK ','N ','N2O ','N2O5 ', & + 'ncl_a1 ','ncl_a2 ','ncl_a3 ','NH3 ','NH4 ', & + 'NH_5 ','NH_50 ','NO ','NO2 ','NO3 ', & + 'NOA ','num_a1 ','num_a2 ','num_a3 ','num_a4 ', & + 'num_a5 ','O ','O3 ','O3S ','OCLO ', & + 'OCS ','ONITR ','PAN ','pom_a1 ','pom_a4 ', & + 'POOH ','ROOH ','S ','SF6 ','SO ', & + 'SO2 ','SO3 ','so4_a1 ','so4_a2 ','so4_a3 ', & + 'so4_a5 ','soa_a1 ','soa_a2 ','SOAE ','SOAG ', & + 'ST80_25 ','TERP ','XOOH ','NHDEP ','NDEP ', & + 'C2H5O2 ','C3H7O2 ','CH3CO3 ','CH3O2 ','EO ', & + 'EO2 ','HO2 ','ISOPO2 ','MACRO2 ','MCO3 ', & + 'O1D ','OH ','PO2 ','RO2 ','XO2 ', & + 'H2O ' /) + + adv_mass(:141) = (/ 12.011000_r8, 12.011000_r8, 72.143800_r8, 79.904000_r8, 115.356700_r8, & + 95.903400_r8, 141.908940_r8, 99.716850_r8, 28.051600_r8, 46.065800_r8, & + 62.065200_r8, 30.066400_r8, 42.077400_r8, 76.091000_r8, 44.092200_r8, & + 153.821800_r8, 165.364506_r8, 148.910210_r8, 137.367503_r8, 187.375310_r8, & + 170.921013_r8, 154.466716_r8, 120.913206_r8, 173.833800_r8, 30.025200_r8, & + 94.937200_r8, 133.402300_r8, 44.051000_r8, 50.485900_r8, 58.076800_r8, & + 72.061400_r8, 60.050400_r8, 76.049800_r8, 32.040000_r8, 48.039400_r8, & + 16.040600_r8, 252.730400_r8, 35.452700_r8, 70.905400_r8, 102.904200_r8, & + 51.452100_r8, 97.457640_r8, 100.916850_r8, 28.010400_r8, 44.009800_r8, & + 62.132400_r8, 135.064039_r8, 135.064039_r8, 135.064039_r8, 28.010400_r8, & + 78.064600_r8, 60.050400_r8, 58.035600_r8, 1.007400_r8, 2.014800_r8, & + 259.823613_r8, 34.013600_r8, 98.078400_r8, 80.911400_r8, 116.948003_r8, & + 100.493706_r8, 86.467906_r8, 36.460100_r8, 20.005803_r8, 63.012340_r8, & + 79.011740_r8, 96.910800_r8, 52.459500_r8, 74.076200_r8, 100.113000_r8, & + 68.114200_r8, 162.117940_r8, 118.127200_r8, 70.087800_r8, 120.100800_r8, & + 147.084740_r8, 70.087800_r8, 14.006740_r8, 44.012880_r8, 108.010480_r8, & + 58.442468_r8, 58.442468_r8, 58.442468_r8, 17.028940_r8, 18.036340_r8, & + 28.010400_r8, 28.010400_r8, 30.006140_r8, 46.005540_r8, 62.004940_r8, & + 119.074340_r8, 1.007400_r8, 1.007400_r8, 1.007400_r8, 1.007400_r8, & + 1.007400_r8, 15.999400_r8, 47.998200_r8, 47.998200_r8, 67.451500_r8, & + 60.076400_r8, 133.100140_r8, 121.047940_r8, 12.011000_r8, 12.011000_r8, & + 92.090400_r8, 90.075600_r8, 32.066000_r8, 146.056419_r8, 48.065400_r8, & + 64.064800_r8, 80.064200_r8, 115.107340_r8, 115.107340_r8, 115.107340_r8, & + 115.107340_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 28.010400_r8, 136.228400_r8, 150.126000_r8, 14.006740_r8, 14.006740_r8, & + 61.057800_r8, 75.083600_r8, 75.042400_r8, 47.032000_r8, 61.057800_r8, & + 77.057200_r8, 33.006200_r8, 117.119800_r8, 119.093400_r8, 101.079200_r8, & + 15.999400_r8, 17.006800_r8, 91.083000_r8, 89.068200_r8, 149.118600_r8, & + 18.014200_r8 /) + + crb_mass(:141) = (/ 12.011000_r8, 12.011000_r8, 60.055000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 24.022000_r8, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 36.033000_r8, 36.033000_r8, 36.033000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 24.022000_r8, 24.022000_r8, 12.011000_r8, 36.033000_r8, & + 36.033000_r8, 24.022000_r8, 24.022000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 24.022000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, & + 24.022000_r8, 24.022000_r8, 24.022000_r8, 0.000000_r8, 0.000000_r8, & + 24.022000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 24.022000_r8, & + 24.022000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 36.033000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 48.044000_r8, 48.044000_r8, & + 48.044000_r8, 48.044000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 36.033000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 48.044000_r8, 24.022000_r8, 12.011000_r8, 12.011000_r8, & + 36.033000_r8, 36.033000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 120.110000_r8, 60.055000_r8, 0.000000_r8, 0.000000_r8, & + 24.022000_r8, 36.033000_r8, 24.022000_r8, 12.011000_r8, 24.022000_r8, & + 24.022000_r8, 0.000000_r8, 60.055000_r8, 48.044000_r8, 48.044000_r8, & + 0.000000_r8, 0.000000_r8, 36.033000_r8, 36.033000_r8, 60.055000_r8, & + 0.000000_r8 /) + + fix_mass(: 3) = (/ 0.00000000_r8, 31.9988000_r8, 28.0134800_r8 /) + + clsmap(: 2,1) = (/ 124, 125 /) + clsmap(:139,4) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, & + 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, & + 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, & + 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, & + 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, & + 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, & + 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, & + 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, & + 121, 122, 123, 126, 127, 128, 129, 130, 131, 132, & + 133, 134, 135, 136, 137, 138, 139, 140, 141 /) + + permute(:139,4) = (/ 1, 2, 35, 126, 56, 131, 83, 3, 76, 57, & + 64, 61, 112, 71, 45, 38, 46, 39, 40, 41, & + 42, 43, 44, 77, 125, 86, 47, 113, 68, 95, & + 116, 89, 87, 80, 73, 107, 70, 128, 50, 34, & + 137, 104, 4, 110, 90, 62, 5, 6, 7, 8, & + 48, 105, 92, 124, 111, 36, 84, 49, 100, 51, & + 52, 55, 127, 9, 101, 69, 94, 99, 109, 66, & + 103, 97, 79, 114, 63, 85, 122, 75, 53, 60, & + 10, 11, 12, 37, 13, 14, 15, 138, 133, 136, & + 72, 16, 17, 18, 19, 20, 129, 132, 21, 65, & + 67, 106, 81, 22, 23, 82, 74, 78, 24, 117, & + 102, 58, 25, 26, 27, 28, 29, 30, 31, 32, & + 33, 88, 54, 96, 98, 121, 123, 59, 91, 130, & + 118, 119, 120, 134, 135, 93, 108, 115, 139 /) + + diag_map(:139) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 11, & + 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, & + 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, & + 32, 34, 35, 36, 39, 42, 45, 48, 51, 54, & + 57, 60, 63, 66, 69, 73, 77, 81, 84, 87, & + 89, 93, 97, 100, 103, 108, 111, 116, 120, 124, & + 130, 136, 142, 147, 152, 157, 160, 168, 176, 182, & + 188, 194, 200, 206, 213, 220, 227, 234, 240, 248, & + 252, 260, 268, 276, 283, 292, 301, 308, 318, 323, & + 328, 336, 342, 352, 360, 369, 377, 389, 401, 408, & + 416, 422, 429, 448, 459, 467, 477, 492, 503, 510, & + 514, 530, 550, 560, 578, 591, 602, 626, 649, 668, & + 695, 715, 753, 769, 783, 800, 820, 856, 886, 943, & + 966,1011,1048,1086,1172,1217,1243,1286,1307 /) + + extfrc_lst(: 9) = (/ 'NO2 ','so4_a2 ','SO2 ','so4_a1 ','num_a2 ', & + 'num_a1 ','bc_a4 ','num_a4 ','NO ' /) + + frc_from_dataset(: 9) = (/ .true., .true., .true., .true., .true., & + .true., .true., .true., .false. /) + + inv_lst(: 3) = (/ 'M ', 'O2 ', 'N2 ' /) + + slvd_lst(: 15) = (/ 'C2H5O2 ', 'C3H7O2 ', 'CH3CO3 ', 'CH3O2 ', 'EO ', & + 'EO2 ', 'HO2 ', 'ISOPO2 ', 'MACRO2 ', 'MCO3 ', & + 'O1D ', 'OH ', 'PO2 ', 'RO2 ', 'XO2 ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 200) = (/ 'jh2o_b ', 'jh2o_a ', & + 'jh2o_c ', 'jh2o2 ', & + 'jo2_a ', 'jo2_b ', & + 'jo3_a ', 'jo3_b ', & + 'jhno3 ', 'jho2no2_a ', & + 'jho2no2_b ', 'jn2o ', & + 'jn2o5_a ', 'jn2o5_b ', & + 'jno ', 'jno2 ', & + 'jno3_b ', 'jno3_a ', & + 'jc2h5ooh ', 'jc3h7ooh ', & + 'jch2o_a ', 'jch2o_b ', & + 'jch3cho ', 'jacet ', & + 'jmgly ', 'jch3co3h ', & + 'jch3ooh ', 'jch4_b ', & + 'jch4_a ', 'jco2 ', & + 'jeooh ', 'jglyald ', & + 'jglyoxal ', 'jhyac ', & + 'jisopooh ', 'jmacr_a ', & + 'jmacr_b ', 'jmpan ', & + 'jmvk ', 'jnoa ', & + 'jonitr ', 'jpan ', & + 'jpooh ', 'jrooh ', & + 'jxooh ', 'jbrcl ', & + 'jbro ', 'jbrono2_b ', & + 'jbrono2_a ', 'jccl4 ', & + 'jcf2clbr ', 'jcf3br ', & + 'jcfcl3 ', 'jcfc113 ', & + 'jcfc114 ', 'jcfc115 ', & + 'jcf2cl2 ', 'jch2br2 ', & + 'jch3br ', 'jch3ccl3 ', & + 'jch3cl ', 'jchbr3 ', & + 'jcl2 ', 'jcl2o2 ', & + 'jclo ', 'jclono2_b ', & + 'jclono2_a ', 'jh2402 ', & + 'jhbr ', 'jhcfc141b ', & + 'jhcfc142b ', 'jhcfc22 ', & + 'jhcl ', 'jhf ', & + 'jhobr ', 'jhocl ', & + 'joclo ', 'jsf6 ', & + 'jh2so4 ', 'jocs ', & + 'jso ', 'jso2 ', & + 'jso3 ', 'jsoa_a1 ', & + 'jsoa_a2 ', 'O1D_H2 ', & + 'O1D_H2O ', 'O1D_N2 ', & + 'O1D_O2ab ', 'O1D_O3 ', & + 'O1D_O3a ', 'O_O3 ', & + 'usr_O_O ', 'usr_O_O2 ', & + 'H2_O ', 'H2O2_O ', & + 'H_HO2 ', 'H_HO2a ', & + 'H_HO2b ', 'H_O2 ', & + 'HO2_O ', 'HO2_O3 ', & + 'H_O3 ', 'OH_H2 ', & + 'OH_H2O2 ', 'OH_HO2 ', & + 'OH_O ', 'OH_O3 ', & + 'OH_OH ', 'OH_OH_M ', & + 'usr_HO2_HO2 ', 'HO2NO2_OH ', & + 'N_NO ', 'N_NO2a ', & + 'N_NO2b ', 'N_NO2c ', & + 'N_O2 ', 'NO2_O ', & + 'NO2_O3 ', 'NO2_O_M ', & + 'NO3_HO2 ', 'NO3_NO ', & + 'NO3_O ', 'NO3_OH ', & + 'N_OH ', 'NO_HO2 ', & + 'NO_O3 ', 'NO_O_M ', & + 'O1D_N2Oa ', 'O1D_N2Ob ', & + 'tag_NO2_HO2 ', 'tag_NO2_NO3 ', & + 'tag_NO2_OH ', 'usr_HNO3_OH ', & + 'usr_HO2NO2_M ', 'usr_N2O5_M ', & + 'CL_CH2O ', 'CL_CH4 ', & + 'CL_H2 ', 'CL_H2O2 ', & + 'CL_HO2a ', 'CL_HO2b ', & + 'CL_O3 ', 'CLO_CH3O2 ', & + 'CLO_CLOa ', 'CLO_CLOb ', & + 'CLO_CLOc ', 'CLO_HO2 ', & + 'CLO_NO ', 'CLONO2_CL ', & + 'CLO_NO2_M ', 'CLONO2_O ', & + 'CLONO2_OH ', 'CLO_O ', & + 'CLO_OHa ', 'CLO_OHb ', & + 'HCL_O ', 'HCL_OH ', & + 'HOCL_CL ', 'HOCL_O ', & + 'HOCL_OH ', 'O1D_CCL4 ', & + 'O1D_CF2CLBR ', 'O1D_CFC11 ', & + 'O1D_CFC113 ', 'O1D_CFC114 ', & + 'O1D_CFC115 ', 'O1D_CFC12 ', & + 'O1D_HCLa ', 'O1D_HCLb ', & + 'tag_CLO_CLO_M ', 'usr_CL2O2_M ', & + 'BR_CH2O ', 'BR_HO2 ', & + 'BR_O3 ', 'BRO_BRO ', & + 'BRO_CLOa ', 'BRO_CLOb ', & + 'BRO_CLOc ', 'BRO_HO2 ', & + 'BRO_NO ', 'BRO_NO2_M ', & + 'BRONO2_O ', 'BRO_O ', & + 'BRO_OH ', 'HBR_O ', & + 'HBR_OH ', 'HOBR_O ', & + 'O1D_CF3BR ', 'O1D_CHBR3 ', & + 'O1D_H2402 ', 'O1D_HBRa ', & + 'O1D_HBRb ', 'CH2BR2_CL ', & + 'CH2BR2_OH ', 'CH3BR_CL ', & + 'CH3BR_OH ', 'CH3CCL3_OH ', & + 'CH3CL_CL ', 'CH3CL_OH ' /) + rxt_tag_lst( 201: 363) = (/ 'CHBR3_CL ', 'CHBR3_OH ', & + 'HCFC141B_OH ', 'HCFC142B_OH ', & + 'HCFC22_OH ', 'O1D_CH2BR2 ', & + 'O1D_CH3BR ', 'O1D_HCFC141B ', & + 'O1D_HCFC142B ', 'O1D_HCFC22 ', & + 'CH2O_NO3 ', 'CH2O_O ', & + 'CH2O_OH ', 'CH3O2_CH3O2a ', & + 'CH3O2_CH3O2b ', 'CH3O2_HO2 ', & + 'CH3O2_NO ', 'CH3OH_OH ', & + 'CH3OOH_OH ', 'CH4_OH ', & + 'O1D_CH4a ', 'O1D_CH4b ', & + 'O1D_CH4c ', 'usr_CO_OH ', & + 'C2H4_CL_M ', 'C2H4_O3 ', & + 'C2H5O2_C2H5O2 ', 'C2H5O2_CH3O2 ', & + 'C2H5O2_HO2 ', 'C2H5O2_NO ', & + 'C2H5OH_OH ', 'C2H5OOH_OH ', & + 'C2H6_CL ', 'C2H6_OH ', & + 'CH3CHO_NO3 ', 'CH3CHO_OH ', & + 'CH3CO3_CH3CO3 ', 'CH3CO3_CH3O2 ', & + 'CH3CO3_HO2 ', 'CH3CO3_NO ', & + 'CH3COOH_OH ', 'CH3COOOH_OH ', & + 'EO2_HO2 ', 'EO2_NO ', & + 'EO_M ', 'EO_O2 ', & + 'GLYALD_OH ', 'GLYOXAL_OH ', & + 'PAN_OH ', 'tag_C2H4_OH ', & + 'tag_CH3CO3_NO2 ', 'usr_PAN_M ', & + 'C3H6_NO3 ', 'C3H6_O3 ', & + 'C3H7O2_CH3O2 ', 'C3H7O2_HO2 ', & + 'C3H7O2_NO ', 'C3H7OOH_OH ', & + 'C3H8_OH ', 'CH3COCHO_NO3 ', & + 'CH3COCHO_OH ', 'HYAC_OH ', & + 'NOA_OH ', 'PO2_HO2 ', & + 'PO2_NO ', 'POOH_OH ', & + 'RO2_CH3O2 ', 'RO2_HO2 ', & + 'RO2_NO ', 'ROOH_OH ', & + 'tag_C3H6_OH ', 'usr_CH3COCH3_OH ', & + 'MACRO2_CH3CO3 ', 'MACRO2_CH3O2 ', & + 'MACRO2_HO2 ', 'MACRO2_NO3 ', & + 'MACRO2_NOa ', 'MACRO2_NOb ', & + 'MACR_O3 ', 'MACR_OH ', & + 'MACROOH_OH ', 'MCO3_CH3CO3 ', & + 'MCO3_CH3O2 ', 'MCO3_HO2 ', & + 'MCO3_MCO3 ', 'MCO3_NO ', & + 'MCO3_NO3 ', 'MPAN_OH_M ', & + 'MVK_O3 ', 'MVK_OH ', & + 'tag_MCO3_NO2 ', 'usr_MPAN_M ', & + 'BIGALK_OH ', 'HYDRALD_OH ', & + 'ISOP_NO3 ', 'ISOPNO3_HO2 ', & + 'ISOPNO3_NO ', 'ISOPNO3_NO3 ', & + 'ISOPO2_CH3CO3 ', 'ISOPO2_CH3O2 ', & + 'ISOPO2_HO2 ', 'ISOPO2_NO ', & + 'ISOPO2_NO3 ', 'ISOP_O3 ', & + 'ISOP_OH ', 'ISOPOOH_OH ', & + 'ONITR_NO3 ', 'ONITR_OH ', & + 'XO2_CH3CO3 ', 'XO2_CH3O2 ', & + 'XO2_HO2 ', 'XO2_NO ', & + 'XO2_NO3 ', 'XOOH_OH ', & + 'TERP_NO3 ', 'TERP_O3 ', & + 'TERP_OH ', 'DMS_NO3 ', & + 'DMS_OHa ', 'OCS_O ', & + 'OCS_OH ', 'S_O2 ', & + 'SO2_OH_M ', 'S_O3 ', & + 'SO_BRO ', 'SO_CLO ', & + 'S_OH ', 'SO_NO2 ', & + 'SO_O2 ', 'SO_O3 ', & + 'SO_OCLO ', 'SO_OH ', & + 'usr_DMS_OH ', 'usr_SO3_H2O ', & + 'NH3_OH ', 'usr_HO2_aer ', & + 'usr_N2O5_aer ', 'usr_NH4_strat_tau ', & + 'usr_NO2_aer ', 'usr_NO3_aer ', & + 'usr_ONITR_aer ', 'SOAE_tau ', & + 'het1 ', 'het10 ', & + 'het11 ', 'het12 ', & + 'het13 ', 'het14 ', & + 'het15 ', 'het16 ', & + 'het17 ', 'het2 ', & + 'het3 ', 'het4 ', & + 'het5 ', 'het6 ', & + 'het7 ', 'het8 ', & + 'het9 ', 'E90_tau ', & + 'NH_50_tau ', 'NH_5_tau ', & + 'ST80_25_tau ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, & + 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, & + 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, & + 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, & + 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, & + 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, & + 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, & + 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, & + 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, & + 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, & + 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, & + 151, 152, 153, 154, 155, 156, 157, 158, 159, 160, & + 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, & + 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, & + 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, & + 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, & + 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, & + 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, & + 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, & + 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, & + 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, & + 251, 252, 253, 254, 255, 256, 257, 258, 259, 260, & + 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, & + 271, 272, 273, 274, 275, 276, 277, 278, 279, 280, & + 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, & + 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, & + 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, & + 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, & + 321, 322, 323, 324, 325, 326, 327, 328, 329, 330, & + 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, & + 341, 342, 343, 344, 345, 346, 347, 348, 349, 350, & + 351, 352, 353, 354, 355, 356, 357, 358, 359, 360, & + 361, 362, 363 /) + if( allocated( pht_alias_lst ) ) then + deallocate( pht_alias_lst ) + end if + allocate( pht_alias_lst(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_lst; error = ',ios + call endrun + end if + if( allocated( pht_alias_mult ) ) then + deallocate( pht_alias_mult ) + end if + allocate( pht_alias_mult(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios + call endrun + end if + pht_alias_lst(:,1) = (/ ' ', ' ', ' ', ' ', & + 'userdefined ', 'userdefined ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', 'userdefined ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ' /) + pht_alias_lst(:,2) = (/ ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', 'jch3ooh ', 'jch3ooh ', & + ' ', ' ', ' ', ' ', & + ' ', 'jh2o2 ', ' ', ' ', & + ' ', ' ', 'jch3ooh ', ' ', & + 'jmgly ', ' ', 'jch3ooh ', ' ', & + ' ', 'jpan ', ' ', 'jch2o_a ', & + 'jch3cho ', ' ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', 'jno2 ', & + 'jno2 ' /) + pht_alias_mult(:,1) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 0.28_r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, .0004_r8, .0004_r8 /) + allocate( cph_enthalpy(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_enthalpy; error = ',ios + call endrun + end if + allocate( cph_rid(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_rid; error = ',ios + call endrun + end if + cph_rid(:) = (/ 88, 92, 93, 94, 97, & + 100, 101, 102, 103, 106, & + 107, 108, 111, 113, 117, & + 118, 126, 127 /) + cph_enthalpy(:) = (/ 189.810000_r8, 392.190000_r8, 493.580000_r8, 101.390000_r8, 232.590000_r8, & + 203.400000_r8, 226.580000_r8, 120.100000_r8, 194.710000_r8, 293.620000_r8, & + 67.670000_r8, 165.300000_r8, 165.510000_r8, 313.750000_r8, 133.750000_r8, & + 193.020000_r8, 34.470000_r8, 199.170000_r8 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 2, 2, 2, 2, 2, 2, 2, 3, 3, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 3, 2, 2, 3, 3, 3, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 3, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, & + 2, 2, 2, 2, 3, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 3, 2, 2, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 3, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, & + 1, 1, 1, 2, 2, 2, 1, 1, 2, 2, & + 2, 1, 1, 2, 1, 1, 1, 1 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/utils/apex.F90 b/src/chemistry/utils/apex.F90 index d4b60af9b1..bb690a8b42 100644 --- a/src/chemistry/utils/apex.F90 +++ b/src/chemistry/utils/apex.F90 @@ -2015,8 +2015,8 @@ subroutine cofrm(date) ! Set outputs gb(ncoef) and gv(ncoef) ! These are module data above. ! - gb(1) = 0._r8 - gv(1) = 0._r8 + gb(:) = 0._r8 + gv(:) = 0._r8 f0 = -1.e-5_r8 do k=2,kmx if (n < m) then diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 28e1d848f2..a0b35e5a1d 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -5516,6 +5516,7 @@ subroutine wshist (rgnht_in) #endif integer :: yr, mon, day ! year, month, and day components of a date + integer :: yr_mid, mon_mid, day_mid ! year, month, and day components of midpoint date integer :: nstep ! current timestep number integer :: ncdate(maxsplitfiles) ! current (or midpoint) date in integer format [yyyymmdd] integer :: ncsec(maxsplitfiles) ! current (or midpoint) time of day [seconds] @@ -5529,7 +5530,6 @@ subroutine wshist (rgnht_in) logical :: prev ! Label file with previous date rather than current logical :: duplicate ! Flag for duplicate file name integer :: ierr - integer :: ncsec_temp #if ( defined BFB_CAM_SCAM_IOP ) integer :: tsec ! day component of current time integer :: dtime ! seconds component of current time @@ -5583,6 +5583,7 @@ subroutine wshist (rgnht_in) end if end if end if + time = ndcur + nscur/86400._r8 if (is_initfile(file_index=t)) then tdata = time ! Inithist file is always instantanious data @@ -5590,10 +5591,12 @@ subroutine wshist (rgnht_in) tdata(1) = beg_time(t) tdata(2) = time end if + ! Set midpoint date/datesec for accumulated file - call set_date_from_time_float((tdata(1) + tdata(2)) / 2._r8, yr, mon, day, ncsec_temp) - ncsec(accumulated_file_index) = ncsec_temp - ncdate(accumulated_file_index) = yr*10000 + mon*100 + day + call set_date_from_time_float((tdata(1) + tdata(2)) / 2._r8, & + yr_mid, mon_mid, day_mid, ncsec(accumulated_file_index) ) + ncdate(accumulated_file_index) = yr_mid*10000 + mon_mid*100 + day_mid + if (hstwr(t) .or. (restart .and. rgnht(t))) then if(masterproc) then if(is_initfile(file_index=t)) then @@ -5609,7 +5612,7 @@ subroutine wshist (rgnht_in) if (f == instantaneous_file_index) then write(iulog,200) nfils(t),'instantaneous',t,yr,mon,day,ncsec(f) else - write(iulog,200) nfils(t),'accumulated',t,yr,mon,day,ncsec(f) + write(iulog,200) nfils(t),'accumulated',t,yr_mid,mon_mid,day_mid,ncsec(f) end if 200 format('WSHIST: writing time sample ',i3,' to ', a, ' h-file ', & i1,' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) diff --git a/src/control/cam_history_support.F90 b/src/control/cam_history_support.F90 index 07ab2dd81a..940dc8c177 100644 --- a/src/control/cam_history_support.F90 +++ b/src/control/cam_history_support.F90 @@ -1407,7 +1407,7 @@ subroutine add_hist_coord_int(name, vlen, long_name, units, values, & if (i == 0) then call add_hist_coord(trim(name), i) if(masterproc) then - write(iulog, '(3a,i0,a,i0)') 'Registering hist coord', trim(name), & + write(iulog, '(3a,i0,a,i0)') 'Registering hist coord: ', trim(name), & '(', i, ') with length: ', vlen end if end if @@ -1472,7 +1472,7 @@ subroutine add_hist_coord_r8(name, vlen, long_name, units, values, & if (i == 0) then call add_hist_coord(trim(name), i) if(masterproc) then - write(iulog, '(3a,i0,a,i0)') 'Registering hist coord', trim(name), & + write(iulog, '(3a,i0,a,i0)') 'Registering hist coord: ', trim(name), & '(', i, ') with length: ', vlen end if end if @@ -1551,7 +1551,7 @@ subroutine add_vert_coord(name, vlen, long_name, units, values, & vertical_coord=.true.) i = get_hist_coord_index(trim(name)) if(masterproc) then - write(iulog, '(3a,i0,a,i0)') 'Registering hist coord', trim(name), & + write(iulog, '(3a,i0,a,i0)') 'Registering hist coord: ', trim(name), & '(', i, ') with length: ', vlen end if end if diff --git a/src/control/camsrfexch.F90 b/src/control/camsrfexch.F90 index de1ea4ce6e..0357ba3128 100644 --- a/src/control/camsrfexch.F90 +++ b/src/control/camsrfexch.F90 @@ -100,6 +100,8 @@ module camsrfexch real(r8) :: tref(pcols) ! ref height surface air temp real(r8) :: qref(pcols) ! ref height specific humidity real(r8) :: u10(pcols) ! 10m wind speed + real(r8) :: ugustOut(pcols) ! gustiness added + real(r8) :: u10withGusts(pcols) ! 10m wind speed with gusts added real(r8) :: ts(pcols) ! merged surface temp real(r8) :: sst(pcols) ! sea surface temp real(r8) :: snowhland(pcols) ! snow depth (liquid water equivalent) over land @@ -218,6 +220,8 @@ subroutine hub2atm_alloc( cam_in ) cam_in(c)%tref (:) = 0._r8 cam_in(c)%qref (:) = 0._r8 cam_in(c)%u10 (:) = 0._r8 + cam_in(c)%ugustOut (:) = 0._r8 + cam_in(c)%u10withGusts (:) = 0._r8 cam_in(c)%ts (:) = 0._r8 cam_in(c)%sst (:) = 0._r8 cam_in(c)%snowhland(:) = 0._r8 diff --git a/src/cpl/nuopc/atm_import_export.F90 b/src/cpl/nuopc/atm_import_export.F90 index baadd00865..c96a01eca4 100644 --- a/src/cpl/nuopc/atm_import_export.F90 +++ b/src/cpl/nuopc/atm_import_export.F90 @@ -245,6 +245,8 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_re' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_ustar' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sx_u10' ) + call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_ugustOut') + call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_u10withGust') call fldlist_add(fldsToAtm_num, fldsToAtm, 'Faxx_taux' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Faxx_tauy' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Faxx_lat' ) @@ -767,6 +769,30 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) end do end if + call state_getfldptr(importState, 'So_ugustOut', fldptr=fldptr1d, exists=exists, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (exists) then + g = 1 + do c = begchunk,endchunk + do i = 1,get_ncols_p(c) + cam_in(c)%ugustOut(i) = fldptr1d(g) + g = g + 1 + end do + end do + end if + + call state_getfldptr(importState, 'So_u10withGust', fldptr=fldptr1d, exists=exists, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (exists) then + g = 1 + do c = begchunk,endchunk + do i = 1,get_ncols_p(c) + cam_in(c)%u10withGusts(i) = fldptr1d(g) + g = g + 1 + end do + end do + end if + ! bgc scenarios call state_getfldptr(importState, 'Fall_fco2_lnd', fldptr=fldptr1d, exists=exists_fco2_lnd, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/dynamics/fv/dp_coupling.F90 b/src/dynamics/fv/dp_coupling.F90 index 64b2e7b9c8..fc02821471 100644 --- a/src/dynamics/fv/dp_coupling.F90 +++ b/src/dynamics/fv/dp_coupling.F90 @@ -576,7 +576,7 @@ subroutine d_p_coupling(grid, phys_state, phys_tend, pbuf2d, dyn_out) ! (note: cam_thermo_dry_air_update assumes dry unless optional conversion factor provided) ! call set_state_pdry(phys_state(lchnk)) ! First get dry pressure to use for this timestep - call set_wet_to_dry(phys_state(lchnk)) ! Dynamics had moist, physics wants dry + call set_wet_to_dry(phys_state(lchnk), convert_cnst_type='dry') ! Dynamics had moist, physics wants dry if (dry_air_species_num>0) then !------------------------------------------------------------ ! Apply limiters to mixing ratios of major species diff --git a/src/dynamics/fv3 b/src/dynamics/fv3 new file mode 160000 index 0000000000..66227690a9 --- /dev/null +++ b/src/dynamics/fv3 @@ -0,0 +1 @@ +Subproject commit 66227690a9fb43a64492de32de14562a25ede717 diff --git a/src/dynamics/fv3/Makefile.in.fv3 b/src/dynamics/fv3/Makefile.in.fv3 deleted file mode 100644 index 1eb3370d3e..0000000000 --- a/src/dynamics/fv3/Makefile.in.fv3 +++ /dev/null @@ -1,175 +0,0 @@ -.SUFFIXES : .F .f .c .o .a .f90 .f95 -######################################################################## -# -# The Makefile for building the FV3 library is created by CAM's configure -# using this template and prepending the following macros: -# -# The macro CAM_BLD is also prepended. It is the build directory of the CAM -# code and it contains the abortutils.mod file. The abortutils module is -# referenced by FV3 code in order to perform an abort which is appropriate -# for the CESM system. -# -# The main customization required for the library to link with CAM is to -# use autopromotion of the default real type to real*8. This is required -# in most, though not all, of the FV3 files. Also, some compilers require -# special flags to specify fixed or free format source (rather than depend -# on filename extensions). Thus, the explicit rules at the end of this -# template for compiling FV3 files have been modified to allow different -# sets of flags for 1) files that cannot be compiled with autopromotion, -# and 2) files that use fixed format source. -# -# The generated Makefile will be used by a sub-Make issued from CAM's Make. -# The sub-Make will inherit the macros: -# -# FC name of Fortran90 compiler -# FC_FLAGS Fortran compiler flags -# -######################################################################## - -# Load dependency search path. -cpp_dirs := . -cpp_dirs += $(shell cat Filepath) - -# Create VPATH from Filepath file created by CAM configure -# Expand any tildes in directory names. Change spaces to colons. -VPATH := $(foreach dir,$(cpp_dirs),$(wildcard $(dir))) -VPATH := $(subst $(space),:,$(VPATH)) - -INCS := $(foreach dir,$(cpp_dirs),-I$(dir)) - -F90 := $(FC) -C90 := $(CC) -F90FLAGS := $(FREEFLAGS) $(FFLAGS) - -OBJS = a2b_edge.o boundary.o dyn_core.o external_ic.o \ - external_sst.o fv_arrays.o fv_cmp.o fv_control.o \ - fv_diagnostics.o fv_dynamics.o fv_eta.o fv_fill.o \ - fv_grid_tools.o fv_grid_utils.o fv_io.o fv_mapz.o \ - fv_mp_mod.o fv_nesting.o fv_nudge.o fv_regional_bc.o \ - fv_restart.o fv_sg.o fv_surf_map.o fv_timing.o \ - fv_tracer2d.o fv_treat_da_inc.o fv_update_phys.o gfdl_cloud_microphys.o \ - init_hydro.o module_mp_radar.o nh_core.o nh_utils.o sim_nc_mod.o \ - sorted_index.o sw_core.o test_cases.o tp_core.o - -complib: libfv3core.a - -libfv3core.a: $(OBJS) - ar cr libfv3core.a $(OBJS) - -db_files: - @echo " " - @echo "* VPATH := $(VPATH)" -db_flags: - @echo " " - @echo "* cc := $(CC) $(CFLAGS) $(INCLDIR) $(INCS)" - @echo "* .F.o := $(FC) $(F90FLAGS) $(INCLDIR) $(INCS)" - -#------------------------------------------------------------------------------- -# Rules for gnu specific compiler directives for FV3 library code -#------------------------------------------------------------------------------- - -ifeq ($(FC_TYPE), gnu) -fv_arrays.o: fv_arrays.F90 - $(F90) -c $(INCLDIR) $(INCS) $(F90FLAGS) -fno-range-check $< - -fv_regional_bc.o: fv_regional_bc.F90 - $(F90) -c $(INCLDIR) $(INCS) $(F90FLAGS) -fno-range-check $< - -gfdl_cloud_microphys.o: gfdl_cloud_microphys.F90 - $(F90) -c $(INCLDIR) $(INCS) $(F90FLAGS) -fdec $< - -module_mp_radar.o: module_mp_radar.F90 - $(F90) -c $(INCLDIR) $(INCS) $(F90FLAGS) -fdec $< -endif - -%.o: %.f90 - $(F90) $(F90FLAGS) $(INCLDIR) $(INCS) -c $< -%.o: %.F90 - $(F90) $(F90FLAGS) $(INCLDIR) $(INCS) -c $< -%.o: %.c - $(C90) $(CFLAGS) $(INCLDIR) $(INCS) -c $< - -# Dependencies (FV3 library) -# Declare all module files used to build each object. -a2b_edge.o : a2b_edge.F90 fv_arrays_mod.mod fv_grid_utils_mod.mod -boundary.o : boundary.F90 fv_arrays_mod.mod fv_timing_mod.mod fv_mp_mod.mod -dyn_core.o : dyn_core.F90 fv_update_phys_mod.mod a2b_edge_mod.mod fv_arrays_mod.mod fv_nwp_nudge_mod.mod fv_regional_mod.mod fv_mp_mod.mod nh_core_mod.mod test_cases_mod.mod boundary_mod.mod fv_timing_mod.mod fv_diagnostics_mod.mod sw_core_mod.mod tp_core_mod.mod -external_ic.o : external_ic.F90 fv_mapz_mod.mod fv_io_mod.mod fv_eta_mod.mod fv_arrays_mod.mod fv_regional_mod.mod sim_nc_mod.mod fv_surf_map_mod.mod boundary_mod.mod fv_grid_utils_mod.mod fv_fill_mod.mod fv_timing_mod.mod fv_diagnostics_mod.mod external_sst_mod.mod init_hydro_mod.mod fv_nwp_nudge_mod.mod fv_mp_mod.mod test_cases_mod.mod -external_sst.o : external_sst.F90 -fv_arrays.o : fv_arrays.F90 -fv_cmp.o : fv_cmp.F90 fv_arrays_mod.mod gfdl_cloud_microphys_mod.mod fv_mp_mod.mod -fv_control.o : fv_control.F90 fv_io_mod.mod fv_eta_mod.mod fv_arrays_mod.mod fv_grid_utils_mod.mod fv_diagnostics_mod.mod fv_timing_mod.mod fv_grid_tools_mod.mod fv_mp_mod.mod fv_restart_mod.mod test_cases_mod.mod -fv_diagnostics.o : fv_diagnostics.F90 fv_mapz_mod.mod fv_eta_mod.mod fv_arrays_mod.mod fv_sg_mod.mod fv_surf_map_mod.mod fv_grid_utils_mod.mod a2b_edge_mod.mod gfdl_cloud_microphys_mod.mod fv_mp_mod.mod -fv_dynamics.o : fv_dynamics.F90 fv_mapz_mod.mod fv_arrays_mod.mod fv_regional_mod.mod fv_sg_mod.mod boundary_mod.mod fv_grid_utils_mod.mod fv_diagnostics_mod.mod fv_timing_mod.mod fv_fill_mod.mod dyn_core_mod.mod fv_nesting_mod.mod fv_tracer2d_mod.mod fv_nwp_nudge_mod.mod fv_mp_mod.mod -fv_eta.o : fv_eta.F90 fv_mp_mod.mod -fv_fill.o : fv_fill.F90 -fv_grid_tools.o : fv_grid_tools.F90 fv_arrays_mod.mod fv_grid_utils_mod.mod fv_timing_mod.mod fv_mp_mod.mod sorted_index_mod.mod -fv_grid_utils.o : fv_grid_utils.F90 fv_eta_mod.mod fv_arrays_mod.mod fv_timing_mod.mod external_sst_mod.mod fv_mp_mod.mod -fv_io.o : fv_io.F90 fv_mapz_mod.mod fv_eta_mod.mod fv_arrays_mod.mod external_sst_mod.mod fv_mp_mod.mod -fv_mapz.o : fv_mapz.F90 fv_arrays_mod.mod fv_grid_utils_mod.mod fv_timing_mod.mod fv_fill_mod.mod fv_cmp_mod.mod fv_mp_mod.mod -fv_mp_mod.o : fv_mp_mod.F90 fv_arrays_mod.mod -fv_nesting.o : fv_nesting.F90 fv_mapz_mod.mod fv_arrays_mod.mod fv_sg_mod.mod boundary_mod.mod fv_grid_utils_mod.mod fv_diagnostics_mod.mod fv_timing_mod.mod init_hydro_mod.mod fv_mp_mod.mod fv_restart_mod.mod sw_core_mod.mod -fv_nudge.o : fv_nudge.F90 fv_mapz_mod.mod fv_arrays_mod.mod sim_nc_mod.mod fv_grid_utils_mod.mod fv_timing_mod.mod fv_diagnostics_mod.mod external_sst_mod.mod fv_mp_mod.mod tp_core_mod.mod -fv_regional_bc.o : fv_regional_bc.F90 fv_mapz_mod.mod fv_eta_mod.mod fv_arrays_mod.mod fv_grid_utils_mod.mod fv_fill_mod.mod fv_diagnostics_mod.mod fv_mp_mod.mod -fv_restart.o : fv_restart.F90 fv_io_mod.mod fv_eta_mod.mod fv_arrays_mod.mod fv_treat_da_inc_mod.mod external_ic_mod.mod fv_surf_map_mod.mod boundary_mod.mod fv_grid_utils_mod.mod fv_timing_mod.mod fv_diagnostics_mod.mod init_hydro_mod.mod fv_mp_mod.mod test_cases_mod.mod -fv_sg.o : fv_sg.F90 gfdl_cloud_microphys_mod.mod fv_mp_mod.mod -fv_surf_map.o : fv_surf_map.F90 fv_arrays_mod.mod fv_grid_utils_mod.mod fv_timing_mod.mod fv_mp_mod.mod -fv_timing.o : fv_timing.F90 fv_mp_mod.mod -fv_tracer2d.o : fv_tracer2d.F90 fv_arrays_mod.mod fv_regional_mod.mod boundary_mod.mod fv_timing_mod.mod fv_mp_mod.mod tp_core_mod.mod -fv_treat_da_inc.o : fv_treat_da_inc.F90 fv_arrays_mod.mod sim_nc_mod.mod fv_grid_utils_mod.mod fv_mp_mod.mod -fv_update_phys.o : fv_update_phys.F90 fv_mapz_mod.mod fv_eta_mod.mod fv_arrays_mod.mod boundary_mod.mod fv_grid_utils_mod.mod fv_diagnostics_mod.mod fv_timing_mod.mod fv_nwp_nudge_mod.mod fv_mp_mod.mod -gfdl_cloud_microphys.o : gfdl_cloud_microphys.F90 module_mp_radar.mod -init_hydro.o : init_hydro.F90 fv_arrays_mod.mod fv_grid_utils_mod.mod fv_mp_mod.mod -module_mp_radar.o : module_mp_radar.F90 -nh_core.o : nh_core.F90 nh_utils_mod.mod tp_core_mod.mod -nh_utils.o : nh_utils.F90 fv_arrays_mod.mod sw_core_mod.mod tp_core_mod.mod -sim_nc_mod.o : sim_nc_mod.F90 -sorted_index.o : sorted_index.F90 fv_arrays_mod.mod -sw_core.o : sw_core.F90 fv_arrays_mod.mod a2b_edge_mod.mod fv_mp_mod.mod test_cases_mod.mod tp_core_mod.mod -test_cases.o : test_cases.F90 fv_arrays_mod.mod fv_eta_mod.mod fv_sg_mod.mod fv_surf_map_mod.mod fv_grid_utils_mod.mod fv_diagnostics_mod.mod fv_grid_tools_mod.mod init_hydro_mod.mod fv_mp_mod.mod -tp_core.o : tp_core.F90 fv_arrays_mod.mod fv_grid_utils_mod.mod fv_mp_mod.mod - -# The following section relates each module to the corresponding file. - -a2b_edge_mod.mod : a2b_edge.o -boundary_mod.mod : boundary.o -dyn_core_mod.mod : dyn_core.o -external_ic_mod.mod : external_ic.o -external_sst_mod.mod : external_sst.o -fv_arrays_mod.mod : fv_arrays.o -fv_cmp_mod.mod : fv_cmp.o -fv_diagnostics_mod.mod : fv_diagnostics.o -fv_eta_mod.mod : fv_eta.o -fv_fill_mod.mod : fv_fill.o -fv_grid_tools_mod.mod : fv_grid_tools.o -fv_grid_utils_mod.mod : fv_grid_utils.o -fv_io_mod.mod : fv_io.o -fv_mapz_mod.mod : fv_mapz.o -fv_mp_mod.mod : fv_mp_mod.o -fv_nesting_mod.mod : fv_nesting.o -fv_nwp_nudge_mod.mod : fv_nudge.o -fv_regional_mod.mod : fv_regional_bc.o -fv_restart_mod.mod : fv_restart.o -fv_sg_mod.mod : fv_sg.o -fv_surf_map_mod.mod : fv_surf_map.o -fv_timing_mod.mod : fv_timing.o -fv_tracer2d_mod.mod : fv_tracer2d.o -fv_treat_da_inc_mod.mod : fv_treat_da_inc.o -fv_update_phys_mod.mod : fv_update_phys.o -gfdl_cloud_microphys_mod.mod : gfdl_cloud_microphys.o -init_hydro_mod.mod : init_hydro.o -module_mp_radar.mod : module_mp_radar.o -nh_core_mod.mod : nh_core.o -nh_utils_mod.mod : nh_utils.o -sim_nc_mod.mod : sim_nc_mod.o -sorted_index_mod.mod : sorted_index.o -sw_core_mod.mod : sw_core.o -test_cases_mod.mod : test_cases.o -tp_core_mod.mod : tp_core.o - -# -clean_objs: - rm -f $(OBJS) *.mod *.o - -clean: - rm -f libfv3core.a $(OBJS) *.mod *.o diff --git a/src/dynamics/fv3/dimensions_mod.F90 b/src/dynamics/fv3/dimensions_mod.F90 deleted file mode 100644 index a0cfa139b8..0000000000 --- a/src/dynamics/fv3/dimensions_mod.F90 +++ /dev/null @@ -1,35 +0,0 @@ -module dimensions_mod - use shr_kind_mod, only: r8=>shr_kind_r8 - - implicit none - private - - - !These are convenience variables for local use only, and are set to values in Atm% - integer, public :: npx, npy, ntiles - - integer, parameter, public :: nlev=PLEV - integer, parameter, public :: nlevp=nlev+1 - - ! - ! The variables below hold indices of water vapor and condensate loading tracers as well as - ! associated heat capacities (initialized in dyn_init): - ! - ! qsize_condensate_loading_idx = FV3 index of water tracers included in condensate loading according to FV3 dynamics - ! qsize_condensate_loading_idx_gll = CAM index of water tracers included in condensate loading terms given FV3 index - ! - integer, allocatable, public :: qsize_tracer_idx_cam2dyn(:) - character(len=16), allocatable, public :: cnst_name_ffsl(:) ! constituent names for FV3 tracers - character(len=128), allocatable, public :: cnst_longname_ffsl(:) ! long name of FV3 tracers - ! - !moist cp in energy conversion term - ! - ! .false.: force dycore to use cpd (cp dry) instead of moist cp - ! .true. : use moist cp in dycore - ! - logical , public :: fv3_lcp_moist = .false. - logical , public :: fv3_lcv_moist = .false. - logical , public :: fv3_scale_ttend = .false. - -end module dimensions_mod - diff --git a/src/dynamics/fv3/dp_coupling.F90 b/src/dynamics/fv3/dp_coupling.F90 deleted file mode 100644 index 3b7fcca69b..0000000000 --- a/src/dynamics/fv3/dp_coupling.F90 +++ /dev/null @@ -1,1087 +0,0 @@ -module dp_coupling - -!------------------------------------------------------------------------------- -! dynamics - physics coupling module -!------------------------------------------------------------------------------- - -use cam_abortutils, only: endrun -use cam_logfile, only: iulog -use constituents, only: pcnst -use dimensions_mod, only: npx,npy,nlev, & - cnst_name_ffsl, cnst_longname_ffsl,fv3_lcp_moist,fv3_lcv_moist, & - qsize_tracer_idx_cam2dyn,fv3_scale_ttend -use dyn_comp, only: dyn_export_t, dyn_import_t -use dyn_grid, only: get_gcol_block_d,mytile -use fv_grid_utils_mod, only: g_sum -use hycoef, only: hyam, hybm, hyai, hybi, ps0 -use mpp_domains_mod, only: mpp_update_domains, domain2D, DGRID_NE -use perf_mod, only: t_startf, t_stopf, t_barrierf -use physconst, only: cpair, gravit, rair, zvir, cappa -use air_composition, only: rairv -use phys_grid, only: get_ncols_p, get_gcol_all_p, block_to_chunk_send_pters, & - transpose_block_to_chunk, block_to_chunk_recv_pters, & - chunk_to_block_send_pters, transpose_chunk_to_block, & - chunk_to_block_recv_pters -use physics_types, only: physics_state, physics_tend -use ppgrid, only: begchunk, endchunk, pcols, pver, pverp -use shr_kind_mod, only: r8=>shr_kind_r8, i8 => shr_kind_i8 -use spmd_dyn, only: local_dp_map, block_buf_nrecs, chunk_buf_nrecs -use spmd_utils, only: mpicom, iam, npes,masterproc - -implicit none -private -public :: d_p_coupling, p_d_coupling - -!======================================================================= -contains -!======================================================================= - -subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) - - ! Convert the dynamics output state into the physics input state. - ! Note that all pressures and tracer mixing ratios coming from the FV3 dycore are based on - ! wet air mass. - - - use cam_abortutils, only: endrun - use fv_arrays_mod, only: fv_atmos_type - use fv_grid_utils_mod, only: cubed_to_latlon - use physics_buffer, only: physics_buffer_desc - - ! arguments - type (dyn_export_t), intent(inout) :: dyn_out ! dynamics export - type (physics_buffer_desc), pointer :: pbuf2d(:,:) - type (physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state - type (physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend - - ! LOCAL VARIABLES - - integer :: ib ! indices over elements - integer :: ioff - integer :: lchnk, icol, ilyr ! indices over chunks, columns, layers - integer :: m, m_ffsl, n, i, j, k - - integer :: cpter(pcols, 0:pver) ! offsets into chunk buffer for unpacking data - - integer :: pgcols(pcols), idmb1(1), idmb2(1), idmb3(1) - integer :: tsize ! amount of data per grid point passed to physics - type (fv_atmos_type), pointer :: Atm(:) - - integer :: is,ie,js,je - integer :: ncols - - ! LOCAL Allocatables - integer, allocatable, dimension(:,:) :: bpter !((ie-is+1)*(je-js+1),0:pver) ! packing data block buffer offset - real(r8), allocatable, dimension(:) :: bbuffer, cbuffer ! transpose buffers - real(r8), allocatable, dimension(:,:) :: phis_tmp !((ie-is+1)*(je-js+1), 1) ! temporary array to hold phis - real(r8), allocatable, dimension(:,:) :: ps_tmp !((ie-is+1)*(je-js+1), 1) ! temporary array to hold ps - real(r8), allocatable, dimension(:,:,:) :: T_tmp !((ie-is+1)*(je-js+1),pver,1) ! temporary array to hold T - real(r8), allocatable, dimension(:,:,:) :: omega_tmp!((ie-is+1)*(je-js+1),pver,1) ! temporary array to hold omega - real(r8), allocatable, dimension(:,:,:) :: pdel_tmp !((ie-is+1)*(je-js+1),pver,1) ! temporary array to hold pdel - real(r8), allocatable, dimension(:,:,:) :: u_tmp !((ie-is+1)*(je-js+1),pver,1) ! temp array to hold u - real(r8), allocatable, dimension(:,:,:) :: v_tmp !((ie-is+1)*(je-js+1),pver,1) ! temp array to hold v - real(r8), allocatable, dimension(:,:,:,:) :: q_tmp !((ie-is+1)*(je-js+1),pver,pcnst,1) ! temp to hold advected constituents - - !----------------------------------------------------------------------- - - Atm=>dyn_out%atm - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - - ! Allocate temporary arrays to hold data for physics decomposition - allocate(ps_tmp ((ie-is+1)*(je-js+1), 1)) - allocate(phis_tmp ((ie-is+1)*(je-js+1), 1)) - allocate(T_tmp ((ie-is+1)*(je-js+1),pver, 1)) - allocate(u_tmp ((ie-is+1)*(je-js+1),pver, 1)) - allocate(v_tmp ((ie-is+1)*(je-js+1),pver, 1)) - allocate(omega_tmp((ie-is+1)*(je-js+1),pver, 1)) - allocate(pdel_tmp ((ie-is+1)*(je-js+1),pver, 1)) - allocate(Q_tmp ((ie-is+1)*(je-js+1),pver,pcnst, 1)) - - ps_tmp = 0._r8 - phis_tmp = 0._r8 - T_tmp = 0._r8 - u_tmp = 0._r8 - v_tmp = 0._r8 - omega_tmp= 0._r8 - pdel_tmp = 0._r8 - Q_tmp = 0._r8 - - n = 1 - do j = js, je - do i = is, ie - ps_tmp (n, 1) = Atm(mytile)%ps (i, j) - phis_tmp(n, 1) = Atm(mytile)%phis(i, j) - do k = 1, pver - T_tmp (n, k, 1) = Atm(mytile)%pt (i, j, k) - u_tmp (n, k, 1) = Atm(mytile)%ua (i, j, k) - v_tmp (n, k, 1) = Atm(mytile)%va (i, j, k) - omega_tmp(n, k, 1) = Atm(mytile)%omga(i, j, k) - pdel_tmp (n, k, 1) = Atm(mytile)%delp(i, j, k) - ! - ! The fv3 constituent array may be in a different order than the cam array, remap here. - ! - do m = 1, pcnst - m_ffsl=qsize_tracer_idx_cam2dyn(m) - Q_tmp(n, k, m, 1) = Atm(mytile)%q(i, j, k, m_ffsl) - end do - end do - n = n + 1 - end do - end do - - call t_startf('dpcopy') - if (local_dp_map) then - - !$omp parallel do private (lchnk, ncols, pgcols, icol, idmb1, idmb2, idmb3, ib, ioff, ilyr, m) - do lchnk = begchunk, endchunk - ncols = get_ncols_p(lchnk) - call get_gcol_all_p(lchnk, pcols, pgcols) - do icol = 1, ncols - call get_gcol_block_d(pgcols(icol), 1, idmb1, idmb2, idmb3) - ib = idmb3(1) - ioff = idmb2(1) - phys_state(lchnk)%ps(icol) = ps_tmp (ioff,ib) - phys_state(lchnk)%phis(icol) = phis_tmp(ioff,ib) - do ilyr = 1, pver - phys_state(lchnk)%t (icol,ilyr) = T_tmp (ioff,ilyr,ib) - phys_state(lchnk)%u (icol,ilyr) = u_tmp (ioff,ilyr,ib) - phys_state(lchnk)%v (icol,ilyr) = v_tmp (ioff,ilyr,ib) - phys_state(lchnk)%omega(icol,ilyr) = omega_tmp(ioff,ilyr,ib) - phys_state(lchnk)%pdel(icol,ilyr) = pdel_tmp (ioff,ilyr,ib) - do m = 1, pcnst - phys_state(lchnk)%q(icol,ilyr,m) = Q_tmp(ioff,ilyr,m,ib) - end do - end do - end do - - end do - - - else ! .not. local_dp_map - - tsize = 5 + pcnst - ib = 1 - - allocate(bbuffer(tsize*block_buf_nrecs)) - allocate(cbuffer(tsize*chunk_buf_nrecs)) - allocate(bpter((ie-is+1)*(je-js+1),0:pver)) - - if (iam < npes) then - call block_to_chunk_send_pters(iam+1, (ie-is+1)*(je-js+1), pver+1, tsize, bpter) - do icol = 1, (ie-is+1)*(je-js+1) - bbuffer(bpter(icol,0)+2:bpter(icol,0)+tsize-1) = 0.0_r8 - bbuffer(bpter(icol,0)) = ps_tmp (icol,ib) - bbuffer(bpter(icol,0)+1) = phis_tmp(icol,ib) - do ilyr = 1, pver - bbuffer(bpter(icol,ilyr)) = T_tmp(icol,ilyr,ib) - bbuffer(bpter(icol,ilyr)+1) = u_tmp(icol,ilyr,ib) - bbuffer(bpter(icol,ilyr)+2) = v_tmp(icol,ilyr,ib) - bbuffer(bpter(icol,ilyr)+3) = omega_tmp(icol,ilyr,ib) - bbuffer(bpter(icol,ilyr)+4) = pdel_tmp (icol,ilyr,ib) - do m = 1, pcnst - bbuffer(bpter(icol,ilyr)+tsize-pcnst-1+m) = Q_tmp(icol,ilyr,m,ib) - end do - end do - end do - else - bbuffer(:) = 0._r8 - end if - - call t_barrierf ('sync_blk_to_chk', mpicom) - call t_startf ('block_to_chunk') - call transpose_block_to_chunk(tsize, bbuffer, cbuffer) - call t_stopf ('block_to_chunk') - - do lchnk = begchunk,endchunk - ncols = phys_state(lchnk)%ncol - call block_to_chunk_recv_pters(lchnk, pcols, pver+1, tsize, cpter) - do icol = 1, ncols - phys_state(lchnk)%ps (icol) = cbuffer(cpter(icol,0)) - phys_state(lchnk)%phis (icol) = cbuffer(cpter(icol,0)+1) - do ilyr = 1, pver - phys_state(lchnk)%t (icol,ilyr) = cbuffer(cpter(icol,ilyr)) - phys_state(lchnk)%u (icol,ilyr) = cbuffer(cpter(icol,ilyr)+1) - phys_state(lchnk)%v (icol,ilyr) = cbuffer(cpter(icol,ilyr)+2) - phys_state(lchnk)%omega (icol,ilyr) = cbuffer(cpter(icol,ilyr)+3) - phys_state(lchnk)%pdel (icol,ilyr) = cbuffer(cpter(icol,ilyr)+4) - do m = 1, pcnst - phys_state(lchnk)%q (icol,ilyr,m) = cbuffer(cpter(icol,ilyr)+tsize-pcnst-1+m) - end do - end do - end do - end do - - deallocate( bbuffer ) - deallocate( cbuffer ) - deallocate( bpter ) - - end if - - deallocate(ps_tmp ) - deallocate(phis_tmp ) - deallocate(T_tmp ) - deallocate(u_tmp ) - deallocate(v_tmp ) - deallocate(omega_tmp) - deallocate(pdel_tmp ) - deallocate(Q_tmp ) - - call t_stopf('dpcopy') - - ! derive the physics state from the dynamics state converting to proper vapor loading - ! and setting dry mixing ratio variables based on cnst_type - no need to call wet_to_dry - ! since derived_phys_dry takes care of that. - - call t_startf('derived_phys_dry') - call derived_phys_dry(phys_state, phys_tend, pbuf2d) - call t_stopf('derived_phys_dry') - -end subroutine d_p_coupling - -!======================================================================= - -subroutine p_d_coupling(phys_state, phys_tend, dyn_in) - - ! Convert the physics output state into the dynamics input state. - - use cam_history, only: outfld - use constants_mod, only: cp_air, kappa - use dyn_comp, only: calc_tot_energy_dynamics - use fms_mod, only: set_domain - use fv_arrays_mod, only: fv_atmos_type - use fv_grid_utils_mod, only: cubed_to_latlon - use air_composition, only: thermodynamic_active_species_num,thermodynamic_active_species_idx_dycore - use air_composition, only: thermodynamic_active_species_cp,thermodynamic_active_species_cv,dry_air_species_num - use physics_types, only: set_state_pdry - use time_manager, only: get_step_size - - ! arguments - type (physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state - type (physics_tend), intent(inout), dimension(begchunk:endchunk) :: phys_tend - type (dyn_import_t), intent(inout) :: dyn_in - - ! LOCAL VARIABLES - - integer :: cpter(pcols,0:pver) ! offsets into chunk buffer for unpacking data - integer :: ib ! indices over elements - integer :: idim - integer :: ioff - integer :: is,isd,ie,ied,js,jsd,je,jed - integer :: lchnk, icol, ilyr ! indices over chunks, columns, layers - integer :: m, n, i, j, k,m_ffsl,nq - integer :: ncols - integer :: pgcols(pcols), idmb1(1), idmb2(1), idmb3(1) - integer :: tsize ! amount of data per grid point passed to physics - integer :: num_wet_species ! total number of wet species (first tracers in FV3 tracer array) - - integer, allocatable, dimension(:,:) :: bpter !((ie-is+1)*(je-js+1),0:pver) ! packing data block buffer offsets - real(r8), allocatable, dimension(:) :: bbuffer, cbuffer ! transpose buffers - - real (r8) :: dt - real (r8) :: fv3_totwatermass, fv3_airmass - real (r8) :: qall,cpfv3 - real (r8) :: tracermass(pcnst) - - type (fv_atmos_type), pointer :: Atm(:) - - real(r8), allocatable, dimension(:,:,:) :: delpdry ! temporary to hold tendencies - real(r8), allocatable, dimension(:,:,:) :: pdel_tmp ! temporary to hold - real(r8), allocatable, dimension(:,:,:) :: pdeldry_tmp ! temporary to hold - real(r8), allocatable, dimension(:,:,:) :: t_dt ! temporary to hold tendencies - real(r8), allocatable, dimension(:,:,:) :: t_dt_tmp ! temporary to hold tendencies - real(r8), allocatable, dimension(:,:,:) :: t_tendadj ! temporary array to temperature tendency adjustment - real(r8), allocatable, dimension(:,:,:) :: u_dt ! temporary to hold tendencies - real(r8), allocatable, dimension(:,:,:) :: u_dt_tmp ! temporary to hold tendencies - real(r8), allocatable, dimension(:,:,:) :: u_tmp ! temporary array to hold u and v - real(r8), allocatable, dimension(:,:,:) :: v_dt ! temporary to hold tendencies - real(r8), allocatable, dimension(:,:,:) :: v_dt_tmp ! temporary to hold tendencies - real(r8), allocatable, dimension(:,:,:) :: v_tmp ! temporary array to hold u and v - real(r8), allocatable, dimension(:,:,:,:) :: q_tmp ! temporary to hold - - !----------------------------------------------------------------------- - - Atm=>dyn_in%atm - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - isd = Atm(mytile)%bd%isd - ied = Atm(mytile)%bd%ied - jsd = Atm(mytile)%bd%jsd - jed = Atm(mytile)%bd%jed - - call set_domain ( Atm(mytile)%domain ) - - allocate(delpdry(isd:ied,jsd:jed,nlev)) - allocate(t_dt_tmp((ie-is+1)*(je-js+1),pver,1)) - allocate(u_dt_tmp((ie-is+1)*(je-js+1),pver,1)) - allocate(v_dt_tmp((ie-is+1)*(je-js+1),pver,1)) - allocate(pdel_tmp((ie-is+1)*(je-js+1),pver,1)) - allocate(pdeldry_tmp((ie-is+1)*(je-js+1),pver,1)) - allocate(U_tmp((ie-is+1)*(je-js+1),pver,1)) - allocate(V_tmp((ie-is+1)*(je-js+1),pver,1)) - allocate(Q_tmp((ie-is+1)*(je-js+1),pver,pcnst,1)) - allocate(u_dt(isd:ied,jsd:jed,nlev)) - allocate(v_dt(isd:ied,jsd:jed,nlev)) - allocate(t_dt(is:ie,js:je,nlev)) - allocate(t_tendadj(is:ie,js:je,nlev)) - - Atm=>dyn_in%atm - - if (local_dp_map) then -!$omp parallel do private (lchnk, ncols, pgcols, icol, idmb1, idmb2, idmb3, ib, ioff, ilyr, m) - do lchnk = begchunk, endchunk - ncols = get_ncols_p(lchnk) - call get_gcol_all_p(lchnk, pcols, pgcols) - call set_state_pdry(phys_state(lchnk)) ! First get dry pressure to use for this timestep - do icol = 1, ncols - call get_gcol_block_d(pgcols(icol), 1, idmb1, idmb2, idmb3) - ib = idmb3(1) - ioff = idmb2(1) - do ilyr = 1, pver - t_dt_tmp(ioff,ilyr,ib) = phys_tend(lchnk)%dtdt(icol,ilyr) - u_tmp(ioff,ilyr,ib) = phys_state(lchnk)%u(icol,ilyr) - v_tmp(ioff,ilyr,ib) = phys_state(lchnk)%v(icol,ilyr) - u_dt_tmp(ioff,ilyr,ib) = phys_tend(lchnk)%dudt(icol,ilyr) - v_dt_tmp(ioff,ilyr,ib) = phys_tend(lchnk)%dvdt(icol,ilyr) - pdel_tmp(ioff,ilyr,ib) = phys_state(lchnk)%pdel(icol,ilyr) - pdeldry_tmp(ioff,ilyr,ib) = phys_state(lchnk)%pdeldry(icol,ilyr) - do m=1, pcnst - Q_tmp(ioff,ilyr,m,ib) = phys_state(lchnk)%q(icol,ilyr,m) - end do - end do - end do - end do - - else - - tsize = 7 + pcnst - ib = 1 - - allocate(bbuffer(tsize*block_buf_nrecs)) - allocate(cbuffer(tsize*chunk_buf_nrecs)) - allocate(bpter((ie-is+1)*(je-js+1),0:pver)) ! offsets into block buffer for packing data - -!$omp parallel do private (lchnk, ncols, cpter, i, icol, ilyr, m) - do lchnk = begchunk, endchunk - - call set_state_pdry(phys_state(lchnk)) ! First get dry pressure to use for this timestep - ncols = get_ncols_p(lchnk) - - call chunk_to_block_send_pters(lchnk, pcols, pver+1, tsize, cpter) - - do i=1,ncols - cbuffer(cpter(i,0):cpter(i,0)+6+pcnst) = 0.0_r8 - end do - - do icol = 1, ncols - - do ilyr = 1, pver - cbuffer(cpter(icol,ilyr)) = phys_tend(lchnk)%dtdt(icol,ilyr) - cbuffer(cpter(icol,ilyr)+1) = phys_state(lchnk)%u(icol,ilyr) - cbuffer(cpter(icol,ilyr)+2) = phys_state(lchnk)%v(icol,ilyr) - cbuffer(cpter(icol,ilyr)+3) = phys_tend(lchnk)%dudt(icol,ilyr) - cbuffer(cpter(icol,ilyr)+4) = phys_tend(lchnk)%dvdt(icol,ilyr) - cbuffer(cpter(icol,ilyr)+5) = phys_state(lchnk)%pdel(icol,ilyr) - cbuffer(cpter(icol,ilyr)+6) = phys_state(lchnk)%pdeldry(icol,ilyr) - do m = 1, pcnst - cbuffer(cpter(icol,ilyr)+6+m) = phys_state(lchnk)%q(icol,ilyr,m) - end do - end do - - end do - - end do - - call t_barrierf('sync_chk_to_blk', mpicom) - call t_startf ('chunk_to_block') - call transpose_chunk_to_block(tsize, cbuffer, bbuffer) - call t_stopf ('chunk_to_block') - - if (iam < npes) then - - call chunk_to_block_recv_pters(iam+1, (ie-is+1)*(je-js+1), pver+1, tsize, bpter) - do icol = 1, (ie-is+1)*(je-js+1) - do ilyr = 1, pver - t_dt_tmp(icol,ilyr,ib) = bbuffer(bpter(icol,ilyr)) - u_tmp(icol,ilyr,ib) = bbuffer(bpter(icol,ilyr)+1) - v_tmp(icol,ilyr,ib) = bbuffer(bpter(icol,ilyr)+2) - u_dt_tmp(icol,ilyr,ib) = bbuffer(bpter(icol,ilyr)+3) - v_dt_tmp(icol,ilyr,ib) = bbuffer(bpter(icol,ilyr)+4) - pdel_tmp(icol,ilyr,ib) = bbuffer(bpter(icol,ilyr)+5) - pdeldry_tmp(icol,ilyr,ib) = bbuffer(bpter(icol,ilyr)+6) - do m = 1, pcnst - Q_tmp(icol,ilyr,m,ib) = bbuffer(bpter(icol,ilyr)+6+m) - end do - end do - end do - - end if - - deallocate(bbuffer) - deallocate(cbuffer) - deallocate(bpter) - - end if - - dt = get_step_size() - - idim=ie-is+1 - -! pt_dt is adjusted below. - n = 1 - do j = js, je - do i = is, ie - do k = 1, pver - t_dt(i, j, k) = t_dt_tmp (n, k, 1) - u_dt(i, j, k) = u_dt_tmp (n, k, 1) - v_dt(i, j, k) = v_dt_tmp (n, k, 1) - Atm(mytile)%ua(i, j, k) = Atm(mytile)%ua(i, j, k) + u_dt(i, j, k)*dt - Atm(mytile)%va(i, j, k) = Atm(mytile)%va(i, j, k) + v_dt(i, j, k)*dt - Atm(mytile)%delp(i, j, k) = pdel_tmp (n, k, 1) - delpdry(i, j, k) = pdeldry_tmp (n, k, 1) - do m = 1, pcnst - ! dynamics tracers may be in a different order from cam tracer array - m_ffsl=qsize_tracer_idx_cam2dyn(m) - Atm(mytile)%q(i, j, k, m_ffsl) = Q_tmp(n, k, m, 1) - end do - end do - n = n + 1 - end do - end do - - ! Update delp and mixing ratios to account for the difference between CAM and FV3 total air mass - ! CAM total air mass (pdel) = (dry + vapor) - ! FV3 total air mass (delp at beg of phys * mix ratio) = - ! drymass + (vapor + condensate [liq_wat,ice_wat,rainwat,snowwat,graupel])*mix ratio - ! FV3 tracer mixing ratios = tracer mass / FV3 total air mass - ! convert the (dry+vap) mixing ratios to be based off of FV3 condensate loaded airmass (dry+vap+cond). When - ! d_p_coupling/derive_phys_dry is called the mixing ratios are again parsed out into wet and - ! dry for physics. - num_wet_species=thermodynamic_active_species_num-dry_air_species_num - ! recalculate ps based on new delp - Atm(mytile)%ps(:,:)=hyai(1)*ps0 - do k=1,pver - do j = js,je - do i = is,ie - do m = 1,pcnst - tracermass(m)=Atm(mytile)%delp(i,j,k)*Atm(mytile)%q(i,j,k,m) - end do - fv3_totwatermass=sum(tracermass(thermodynamic_active_species_idx_dycore(1:num_wet_species))) - fv3_airmass = delpdry(i,j,k) + fv3_totwatermass - Atm(mytile)%delp(i,j,k) = fv3_airmass - Atm(mytile)%q(i,j,k,1:pcnst) = tracermass(1:pcnst)/fv3_airmass - Atm(mytile)%ps(i,j)=Atm(mytile)%ps(i,j)+Atm(mytile)%delp(i, j, k) - end do - end do - end do - - ! update dynamics temperature from physics tendency - ! if using fv3_lcv_moist adjust temperature tendency to conserve energy across phys/dynamics - ! interface accounting for differences in the moist/wet assumptions - - do k = 1, pver - do j = js, je - do i = is, ie - if (fv3_scale_ttend) then - qall=0._r8 - cpfv3=0._r8 - do nq=1,thermodynamic_active_species_num - m_ffsl = thermodynamic_active_species_idx_dycore(nq) - qall=qall+Atm(mytile)%q(i,j,k,m_ffsl) - if (fv3_lcp_moist) cpfv3 = cpfv3+thermodynamic_active_species_cp(nq)*Atm(mytile)%q(i,j,k,m_ffsl) - if (fv3_lcv_moist) cpfv3 = cpfv3+thermodynamic_active_species_cv(nq)*Atm(mytile)%q(i,j,k,m_ffsl) - end do - cpfv3=(1._r8-qall)*cp_air+cpfv3 - ! scale factor for t_dt so temperature tendency derived from CAM moist air (dry+vap - constant pressure) - ! can be applied to FV3 wet air (dry+vap+cond - constant volume) - - t_tendadj(i,j,k)=cp_air/cpfv3 - - if (.not.Atm(mytile)%flagstruct%hydrostatic) then - ! update to nonhydrostatic variable delz to account for phys temperature adjustment. - Atm(mytile)%delz(i, j, k) = Atm(mytile)%delz(i,j,k)/Atm(mytile)%pt(i, j, k) - Atm(mytile)%pt (i, j, k) = Atm(mytile)%pt (i, j, k) + t_dt(i, j, k)*dt*t_tendadj(i,j,k) - Atm(mytile)%delz(i, j, k) = Atm(mytile)%delz(i,j,k)*Atm(mytile)%pt (i, j, k) - else - Atm(mytile)%pt (i, j, k) = Atm(mytile)%pt (i, j, k) + t_dt(i, j, k)*dt*t_tendadj(i,j,k) - end if - else - Atm(mytile)%pt (i, j, k) = Atm(mytile)%pt (i, j, k) + t_dt(i, j, k)*dt - end if - end do - end do - end do - - !$omp parallel do private(i, j) - do j=js,je - do i=is,ie - Atm(mytile)%pe(i,1,j) = Atm(mytile)%ptop - Atm(mytile)%pk(i,j,1) = Atm(mytile)%ptop ** kappa - Atm(mytile)%peln(i,1,j) = log(Atm(mytile)%ptop ) - enddo - enddo - -!$omp parallel do private(i,j,k) - do j=js,je - do k=1,pver - do i=is,ie - Atm(mytile)%pe(i,k+1,j) = Atm(mytile)%pe(i,k,j) + Atm(mytile)%delp(i,j,k) - enddo - enddo - enddo - -!$omp parallel do private(i,j,k) - do j=js,je - do k=1,pver - do i=is,ie - Atm(mytile)%pk(i,j,k+1)= Atm(mytile)%pe(i,k+1,j) ** kappa - Atm(mytile)%peln(i,k+1,j) = log(Atm(mytile)%pe(i,k+1,j)) - Atm(mytile)%pkz(i,j,k) = (Atm(mytile)%pk(i,j,k+1)-Atm(mytile)%pk(i,j,k))/ & - (kappa*(Atm(mytile)%peln(i,k+1,j)-Atm(mytile)%peln(i,k,j))) - enddo - enddo - enddo - - do j = js, je - call outfld('FU', RESHAPE(u_dt(is:ie, j, :),(/idim,pver/)), idim, j) - call outfld('FV', RESHAPE(v_dt(is:ie, j, :),(/idim,pver/)), idim, j) - call outfld('FT', RESHAPE(t_dt(is:ie, j, :),(/idim,pver/)), idim, j) - end do - - call calc_tot_energy_dynamics(dyn_in%atm,'dAP') - - - !set the D-Grid winds from the physics A-grid winds/tendencies. - if ( Atm(mytile)%flagstruct%dwind_2d ) then - call endrun('dwind_2d update is not implemented') - else - call atend2dstate3d( u_dt, v_dt, Atm(mytile)%u ,Atm(mytile)%v, is, ie, js, je, & - isd, ied, jsd, jed, npx,npy, nlev, Atm(mytile)%gridstruct, Atm(mytile)%domain, dt) - endif - - ! Again we are rederiving the A winds from the Dwinds to give our energy dynamics a consistent wind. - call cubed_to_latlon(Atm(mytile)%u, Atm(mytile)%v, Atm(mytile)%ua, Atm(mytile)%va, Atm(mytile)%gridstruct, & - npx, npy, nlev, 1, Atm(mytile)%gridstruct%grid_type, Atm(mytile)%domain, & - Atm(mytile)%gridstruct%nested, Atm(mytile)%flagstruct%c2l_ord, Atm(mytile)%bd) - - !$omp parallel do private(i, j) - do j=js,je - do i=is,ie - Atm(mytile)%u_srf=Atm(mytile)%ua(i,j,pver) - Atm(mytile)%v_srf=Atm(mytile)%va(i,j,pver) - enddo - enddo - - ! update halo regions - call mpp_update_domains( Atm(mytile)%delp, Atm(mytile)%domain ) - call mpp_update_domains( Atm(mytile)%ps, Atm(mytile)%domain ) - call mpp_update_domains( Atm(mytile)%phis, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%ps, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%u,atm(mytile)%v, Atm(mytile)%domain, gridtype=DGRID_NE, complete=.true. ) - call mpp_update_domains( atm(mytile)%pt, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%q, Atm(mytile)%domain ) - - deallocate(delpdry) - deallocate(t_dt_tmp) - deallocate(u_dt_tmp) - deallocate(v_dt_tmp) - deallocate(pdel_tmp) - deallocate(pdeldry_tmp) - deallocate(U_tmp) - deallocate(V_tmp) - deallocate(Q_tmp) - deallocate(u_dt) - deallocate(v_dt) - deallocate(t_dt) - deallocate(t_tendadj) - -end subroutine p_d_coupling - -!======================================================================= - -subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) - - use check_energy, only: check_energy_timestep_init - use constituents, only: qmin - use geopotential, only: geopotential_t - use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk - use physics_types, only: set_wet_to_dry - use air_composition, only: thermodynamic_active_species_num,thermodynamic_active_species_idx_dycore - use air_composition, only: thermodynamic_active_species_idx,dry_air_species_num - use ppgrid, only: pver - use qneg_module, only: qneg3 - use shr_vmath_mod, only: shr_vmath_log - - ! arguments - type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state - type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - - ! local variables - - integer :: num_wet_species ! total number of wet species (first tracers in FV3 tracer array) - integer :: lchnk - integer :: m, i, k, ncol - - real(r8) :: cam_totwatermass, cam_airmass - real(r8), dimension(pcnst) :: tracermass - real(r8), dimension(pcols,pver) :: zvirv ! Local zvir array pointer - - !---------------------------------------------------------------------------- - - type(physics_buffer_desc), pointer :: pbuf_chnk(:) - - ! - ! Evaluate derived quantities - ! - ! At this point the phys_state has been filled in from dynamics, rearranging tracers to match CAM tracer order. - ! pdel is consistent with tracer array. - ! All tracer mixing rations at this point are calculated using dry+vap+condensates - we need to convert - ! to cam physics wet mixing ration based off of dry+vap. - ! Following this loop call wet_to_dry to convert CAM's dry constituents to their dry mixing ratio. - -!!! omp parallel do private (lchnk, ncol, k, i, zvirv, pbuf_chnk,m,cam_airmass,cam_totwatermass) - num_wet_species=thermodynamic_active_species_num-dry_air_species_num - do lchnk = begchunk,endchunk - ncol = get_ncols_p(lchnk) - do k=1,pver - do i=1,ncol - phys_state(lchnk)%pdeldry(i,k) = & - phys_state(lchnk)%pdel(i,k) * & - (1._r8-sum(phys_state(lchnk)%q(i,k,thermodynamic_active_species_idx(1:num_wet_species)))) - do m = 1,pcnst - tracermass(m)=phys_state(lchnk)%pdel(i,k)*phys_state(lchnk)%q(i,k,m) - end do - cam_totwatermass=tracermass(1) - cam_airmass = phys_state(lchnk)%pdeldry(i,k) + cam_totwatermass - phys_state(lchnk)%pdel(i,k) = cam_airmass - phys_state(lchnk)%q(i,k,1:pcnst) = tracermass(1:pcnst)/cam_airmass - end do - end do - -! Physics state now has CAM pdel (dry+vap) and pdeldry and all constituents are dry+vap -! Convert dry type constituents from moist to dry mixing ratio -! - call set_wet_to_dry(phys_state(lchnk)) ! Dynamics had moist, physics wants dry. - -! -! Derive the rest of the pressure variables using pdel and pdeldry -! - - do i = 1, ncol - phys_state(lchnk)%psdry(i) = hyai(1)*ps0 + sum(phys_state(lchnk)%pdeldry(i,:)) - end do - - do i = 1, ncol - phys_state(lchnk)%pintdry(i,1) = hyai(1)*ps0 - end do - call shr_vmath_log(phys_state(lchnk)%pintdry(1:ncol,1), & - phys_state(lchnk)%lnpintdry(1:ncol,1),ncol) - do k = 1, pver - do i = 1, ncol - phys_state(lchnk)%pintdry(i,k+1) = phys_state(lchnk)%pintdry(i,k) + & - phys_state(lchnk)%pdeldry(i,k) - end do - call shr_vmath_log(phys_state(lchnk)%pintdry(1:ncol,k+1),& - phys_state(lchnk)%lnpintdry(1:ncol,k+1),ncol) - end do - - do k=1,pver - do i=1,ncol - phys_state(lchnk)%rpdeldry(i,k) = 1._r8/phys_state(lchnk)%pdeldry(i,k) - phys_state(lchnk)%pmiddry (i,k) = 0.5_r8*(phys_state(lchnk)%pintdry(i,k+1) + & - phys_state(lchnk)%pintdry(i,k)) - end do - call shr_vmath_log(phys_state(lchnk)%pmiddry(1:ncol,k), & - phys_state(lchnk)%lnpmiddry(1:ncol,k),ncol) - end do - - ! initialize moist pressure variables - - do i=1,ncol - phys_state(lchnk)%ps(i) = phys_state(lchnk)%pintdry(i,1) - phys_state(lchnk)%pint(i,1) = phys_state(lchnk)%pintdry(i,1) - end do - do k = 1, pver - do i=1,ncol - phys_state(lchnk)%pint(i,k+1) = phys_state(lchnk)%pint(i,k)+phys_state(lchnk)%pdel(i,k) - phys_state(lchnk)%pmid(i,k) = (phys_state(lchnk)%pint(i,k+1)+phys_state(lchnk)%pint(i,k))/2._r8 - phys_state(lchnk)%ps (i) = phys_state(lchnk)%ps(i) + phys_state(lchnk)%pdel(i,k) - end do - call shr_vmath_log(phys_state(lchnk)%pint(1:ncol,k),phys_state(lchnk)%lnpint(1:ncol,k),ncol) - call shr_vmath_log(phys_state(lchnk)%pmid(1:ncol,k),phys_state(lchnk)%lnpmid(1:ncol,k),ncol) - end do - call shr_vmath_log(phys_state(lchnk)%pint(1:ncol,pverp),phys_state(lchnk)%lnpint(1:ncol,pverp),ncol) - - do k = 1, pver - do i = 1, ncol - phys_state(lchnk)%rpdel(i,k) = 1._r8/phys_state(lchnk)%pdel(i,k) - phys_state(lchnk)%exner (i,k) = (phys_state(lchnk)%pint(i,pver+1) & - / phys_state(lchnk)%pmid(i,k))**cappa - end do - end do - - ! fill zvirv 2D variables to be compatible with geopotential_t interface - zvirv(:,:) = zvir - - ! Compute initial geopotential heights - based on full pressure - call geopotential_t (phys_state(lchnk)%lnpint, phys_state(lchnk)%lnpmid , phys_state(lchnk)%pint , & - phys_state(lchnk)%pmid , phys_state(lchnk)%pdel , phys_state(lchnk)%rpdel , & - phys_state(lchnk)%t , phys_state(lchnk)%q(:,:,:), rairv(:,:,lchnk), gravit, zvirv , & - phys_state(lchnk)%zi , phys_state(lchnk)%zm , ncol ) - - ! Compute initial dry static energy, include surface geopotential - do k = 1, pver - do i = 1, ncol - phys_state(lchnk)%s(i,k) = cpair*phys_state(lchnk)%t(i,k) & - + gravit*phys_state(lchnk)%zm(i,k) + phys_state(lchnk)%phis(i) - end do - end do - ! Ensure tracers are all positive - call qneg3('D_P_COUPLING',lchnk ,ncol ,pcols ,pver , & - 1, pcnst, qmin ,phys_state(lchnk)%q) - - ! Compute energy and water integrals of input state - pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) - call check_energy_timestep_init(phys_state(lchnk), phys_tend(lchnk), pbuf_chnk) - - end do ! lchnk - -end subroutine derived_phys_dry - -subroutine atend2dstate3d(u_dt, v_dt, u, v, is, ie, js, je, isd, ied, jsd, jed, npx,npy, nlev, gridstruct, domain, dt) -!---------------------------------------------------------------------------- -! This routine adds the a-grid wind tendencies returned by the physics to the d-state -! wind being sent to the dynamics. -!---------------------------------------------------------------------------- - - use fv_arrays_mod, only: fv_grid_type - use mpp_domains_mod, only: mpp_update_domains, DGRID_NE - - ! arguments - integer, intent(in) :: npx,npy, nlev - integer, intent(in) :: is, ie, js, je,& - isd, ied, jsd, jed - real(r8), intent(in) :: dt - real(r8), intent(inout), dimension(isd:ied,jsd:jed,nlev) :: u_dt, v_dt - real(r8), intent(inout), dimension(isd:ied, jsd:jed+1,nlev) :: u - real(r8), intent(inout), dimension(isd:ied+1,jsd:jed ,nlev) :: v - type(domain2d), intent(inout) :: domain - type(fv_grid_type), intent(in), target :: gridstruct - - ! local: - - integer i, j, k, im2, jm2 - real(r8) dt5 - real(r8), dimension(is-1:ie+1,js:je+1,3) :: ue ! 3D winds at edges - real(r8), dimension(is-1:ie+1,js-1:je+1,3) :: v3 - real(r8), dimension(is:ie+1,js-1:je+1, 3) :: ve ! 3D winds at edges - real(r8), dimension(is:ie) :: ut1, ut2, ut3 - real(r8), dimension(js:je) :: vt1, vt2, vt3 - real(r8), pointer, dimension(:) :: edge_vect_w, edge_vect_e, edge_vect_s, edge_vect_n - real(r8), pointer, dimension(:,:,:) :: vlon, vlat - real(r8), pointer, dimension(:,:,:,:) :: es, ew - - !---------------------------------------------------------------------------- - - es => gridstruct%es - ew => gridstruct%ew - vlon => gridstruct%vlon - vlat => gridstruct%vlat - - edge_vect_w => gridstruct%edge_vect_w - edge_vect_e => gridstruct%edge_vect_e - edge_vect_s => gridstruct%edge_vect_s - edge_vect_n => gridstruct%edge_vect_n - - call mpp_update_domains(u_dt, domain, complete=.false.) - call mpp_update_domains(v_dt, domain, complete=.true.) - - dt5 = 0.5_r8 * dt - im2 = (npx-1)/2 - jm2 = (npy-1)/2 - -!$OMP parallel do default(none) shared(is,ie,js,je,nlev,gridstruct,u,dt5,u_dt,v,v_dt, & -!$OMP vlon,vlat,jm2,edge_vect_w,npx,edge_vect_e,im2, & -!$OMP edge_vect_s,npy,edge_vect_n,es,ew) & -!$OMP private(ut1, ut2, ut3, vt1, vt2, vt3, ue, ve, v3) - do k=1, nlev - - ! Compute 3D wind/tendency on A grid - do j=js-1,je+1 - do i=is-1,ie+1 - v3(i,j,1) = u_dt(i,j,k)*vlon(i,j,1) + v_dt(i,j,k)*vlat(i,j,1) - v3(i,j,2) = u_dt(i,j,k)*vlon(i,j,2) + v_dt(i,j,k)*vlat(i,j,2) - v3(i,j,3) = u_dt(i,j,k)*vlon(i,j,3) + v_dt(i,j,k)*vlat(i,j,3) - enddo - enddo - - ! Interpolate to cell edges - do j=js,je+1 - do i=is-1,ie+1 - ue(i,j,1) = v3(i,j-1,1) + v3(i,j,1) - ue(i,j,2) = v3(i,j-1,2) + v3(i,j,2) - ue(i,j,3) = v3(i,j-1,3) + v3(i,j,3) - enddo - enddo - - do j=js-1,je+1 - do i=is,ie+1 - ve(i,j,1) = v3(i-1,j,1) + v3(i,j,1) - ve(i,j,2) = v3(i-1,j,2) + v3(i,j,2) - ve(i,j,3) = v3(i-1,j,3) + v3(i,j,3) - enddo - enddo - - ! --- E_W edges (for v-wind): - if (.not. gridstruct%nested) then - if ( is==1) then - i = 1 - do j=js,je - if ( j>jm2 ) then - vt1(j) = edge_vect_w(j)*ve(i,j-1,1)+(1._r8-edge_vect_w(j))*ve(i,j,1) - vt2(j) = edge_vect_w(j)*ve(i,j-1,2)+(1._r8-edge_vect_w(j))*ve(i,j,2) - vt3(j) = edge_vect_w(j)*ve(i,j-1,3)+(1._r8-edge_vect_w(j))*ve(i,j,3) - else - vt1(j) = edge_vect_w(j)*ve(i,j+1,1)+(1._r8-edge_vect_w(j))*ve(i,j,1) - vt2(j) = edge_vect_w(j)*ve(i,j+1,2)+(1._r8-edge_vect_w(j))*ve(i,j,2) - vt3(j) = edge_vect_w(j)*ve(i,j+1,3)+(1._r8-edge_vect_w(j))*ve(i,j,3) - endif - enddo - do j=js,je - ve(i,j,1) = vt1(j) - ve(i,j,2) = vt2(j) - ve(i,j,3) = vt3(j) - enddo - endif - - if ( (ie+1)==npx ) then - i = npx - do j=js,je - if ( j>jm2 ) then - vt1(j) = edge_vect_e(j)*ve(i,j-1,1)+(1._r8-edge_vect_e(j))*ve(i,j,1) - vt2(j) = edge_vect_e(j)*ve(i,j-1,2)+(1._r8-edge_vect_e(j))*ve(i,j,2) - vt3(j) = edge_vect_e(j)*ve(i,j-1,3)+(1._r8-edge_vect_e(j))*ve(i,j,3) - else - vt1(j) = edge_vect_e(j)*ve(i,j+1,1)+(1._r8-edge_vect_e(j))*ve(i,j,1) - vt2(j) = edge_vect_e(j)*ve(i,j+1,2)+(1._r8-edge_vect_e(j))*ve(i,j,2) - vt3(j) = edge_vect_e(j)*ve(i,j+1,3)+(1._r8-edge_vect_e(j))*ve(i,j,3) - endif - enddo - do j=js,je - ve(i,j,1) = vt1(j) - ve(i,j,2) = vt2(j) - ve(i,j,3) = vt3(j) - enddo - endif - ! N-S edges (for u-wind): - if ( js==1) then - j = 1 - do i=is,ie - if ( i>im2 ) then - ut1(i) = edge_vect_s(i)*ue(i-1,j,1)+(1._r8-edge_vect_s(i))*ue(i,j,1) - ut2(i) = edge_vect_s(i)*ue(i-1,j,2)+(1._r8-edge_vect_s(i))*ue(i,j,2) - ut3(i) = edge_vect_s(i)*ue(i-1,j,3)+(1._r8-edge_vect_s(i))*ue(i,j,3) - else - ut1(i) = edge_vect_s(i)*ue(i+1,j,1)+(1._r8-edge_vect_s(i))*ue(i,j,1) - ut2(i) = edge_vect_s(i)*ue(i+1,j,2)+(1._r8-edge_vect_s(i))*ue(i,j,2) - ut3(i) = edge_vect_s(i)*ue(i+1,j,3)+(1._r8-edge_vect_s(i))*ue(i,j,3) - endif - enddo - do i=is,ie - ue(i,j,1) = ut1(i) - ue(i,j,2) = ut2(i) - ue(i,j,3) = ut3(i) - enddo - endif - if ( (je+1)==npy ) then - j = npy - do i=is,ie - if ( i>im2 ) then - ut1(i) = edge_vect_n(i)*ue(i-1,j,1)+(1._r8-edge_vect_n(i))*ue(i,j,1) - ut2(i) = edge_vect_n(i)*ue(i-1,j,2)+(1._r8-edge_vect_n(i))*ue(i,j,2) - ut3(i) = edge_vect_n(i)*ue(i-1,j,3)+(1._r8-edge_vect_n(i))*ue(i,j,3) - else - ut1(i) = edge_vect_n(i)*ue(i+1,j,1)+(1._r8-edge_vect_n(i))*ue(i,j,1) - ut2(i) = edge_vect_n(i)*ue(i+1,j,2)+(1._r8-edge_vect_n(i))*ue(i,j,2) - ut3(i) = edge_vect_n(i)*ue(i+1,j,3)+(1._r8-edge_vect_n(i))*ue(i,j,3) - endif - enddo - do i=is,ie - ue(i,j,1) = ut1(i) - ue(i,j,2) = ut2(i) - ue(i,j,3) = ut3(i) - enddo - endif - - endif ! .not. nested - - do j=js,je+1 - do i=is,ie - u(i,j,k) = u(i,j,k) + dt5*( ue(i,j,1)*es(1,i,j,1) + & - ue(i,j,2)*es(2,i,j,1) + & - ue(i,j,3)*es(3,i,j,1) ) - enddo - enddo - do j=js,je - do i=is,ie+1 - v(i,j,k) = v(i,j,k) + dt5*( ve(i,j,1)*ew(1,i,j,2) + & - ve(i,j,2)*ew(2,i,j,2) + & - ve(i,j,3)*ew(3,i,j,2) ) - enddo - enddo - enddo ! k-loop - - call mpp_update_domains(u, v, domain, gridtype=DGRID_NE) - -end subroutine atend2dstate3d - - -subroutine fv3_tracer_diags(atm) - - ! Dry/Wet surface pressure diagnostics - - use constituents, only: pcnst - use dimensions_mod, only: nlev,cnst_name_ffsl - use dyn_grid, only: mytile - use fv_arrays_mod, only: fv_atmos_type - use air_composition, only: thermodynamic_active_species_num,thermodynamic_active_species_idx_dycore, & - dry_air_species_num - - ! arguments - type (fv_atmos_type), intent(in), pointer :: Atm(:) - - ! Locals - integer :: i, j ,k, m,is,ie,js,je - integer :: num_wet_species ! total number of wet species - integer :: kstrat,ng - real(r8) :: global_ps,global_dryps - real(r8) :: qm_strat - real(r8) :: qtot(pcnst), psum - real(r8), allocatable, dimension(:,:,:) :: delpdry, psq - real(r8), allocatable, dimension(:,:) :: psdry, q_strat - - !---------------------------------------------------------------------------- - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - ng = Atm(mytile)%ng - - allocate(delpdry(is:ie,js:je,nlev)) - allocate(psdry(is:ie,js:je)) - allocate(psq(is:ie,js:je,pcnst)) - allocate(q_strat(is:ie,js:je)) - num_wet_species=thermodynamic_active_species_num-dry_air_species_num - do k=1,nlev - do j = js, je - do i = is, ie - delpdry(i,j,k) = Atm(mytile)%delp(i,j,k) * & - (1.0_r8-sum(Atm(mytile)%q(i,j,k,thermodynamic_active_species_idx_dycore(1:num_wet_species)))) - end do - end do - end do - ! - ! get psdry - ! - do j = js, je - do i = is, ie - psdry(i,j) = hyai(1)*ps0 + sum(delpdry(i,j,:)) - end do - end do - - global_ps = g_sum(Atm(mytile)%domain, Atm(mytile)%ps(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1) - global_dryps = g_sum(Atm(mytile)%domain, psdry(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1) -!------------------- -! Vertical mass sum for all tracers -!------------------- - psq(:,:,:) = 0._r8 - do m=1,pcnst - call z_sum(Atm,is,ie,js,je,nlev,Atm(mytile)%q(is:ie,js:je,1:nlev,m),psq(is:ie,js:je,m)) - end do -! Mean water vapor in the "stratosphere" (75 mb and above): - qm_strat = 0._r8 - if ( Atm(mytile)%idiag%phalf(2)< 75._r8 ) then - kstrat = 1 - do k=2,nlev - if ( Atm(mytile)%idiag%phalf(k+1) > 75._r8 ) exit - kstrat = k - enddo - call z_sum(Atm,is,ie,js,je, kstrat, Atm(mytile)%q(is:ie,js:je,1:kstrat,1 ), q_strat,psum) - qm_strat = g_sum(Atm(mytile)%domain, q_strat(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1) * 1.e6_r8 / psum - endif - - !------------------- - ! Get global mean mass for all tracers - !------------------- - do m=1,pcnst - qtot(m) = g_sum(Atm(mytile)%domain, psq(is,js,m), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1)/gravit - enddo - - if (masterproc) then - write(iulog,*)'Total Surface Pressure (mb) = ',global_ps/100.0_r8,"hPa" - write(iulog,*)'Mean Dry Surface Pressure (mb) = ',global_dryps/100.0_r8,"hPa" - write(iulog,*)'Mean specific humidity (mg/kg) above 75 mb = ',qm_strat - do m=1,pcnst - write(iulog,*)' Total '//cnst_name_ffsl(m)//' (kg/m**2) = ',qtot(m) - enddo - end if - - - deallocate(delpdry) - deallocate(psdry) - deallocate(psq) - deallocate(q_strat) -end subroutine fv3_tracer_diags - - -subroutine z_sum(atm,is,ie,js,je,km,q,msum,gpsum) - - ! vertical integral - - use fv_arrays_mod, only: fv_atmos_type - - ! arguments - - type (fv_atmos_type), intent(in), pointer :: Atm(:) - integer, intent(in) :: is, ie, js, je - integer, intent(in) :: km - real(r8), intent(in), dimension(is:ie, js:je, km) :: q - real(r8), intent(out), dimension(is:ie,js:je) :: msum - real(r8), intent(out), optional :: gpsum - - ! LOCAL VARIABLES - integer :: i,j,k - real(r8), dimension(is:ie,js:je) :: psum - !---------------------------------------------------------------------------- - msum=0._r8 - psum=0._r8 - do j=js,je - do i=is,ie - msum(i,j) = Atm(mytile)%delp(i,j,1)*q(i,j,1) - psum(i,j) = Atm(mytile)%delp(i,j,1) - enddo - do k=2,km - do i=is,ie - msum(i,j) = msum(i,j) + Atm(mytile)%delp(i,j,k)*q(i,j,k) - psum(i,j) = psum(i,j) + Atm(mytile)%delp(i,j,k) - enddo - enddo - enddo - if (present(gpsum)) then - gpsum = g_sum(Atm(mytile)%domain, psum, is, ie, js, je, Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1) - end if -end subroutine z_sum - -end module dp_coupling diff --git a/src/dynamics/fv3/dycore.F90 b/src/dynamics/fv3/dycore.F90 deleted file mode 100644 index eee3177587..0000000000 --- a/src/dynamics/fv3/dycore.F90 +++ /dev/null @@ -1,24 +0,0 @@ -module dycore - - implicit none - private - - public :: dycore_is - -!======================================================================= -contains -!======================================================================= - -logical function dycore_is(name) - - character(len=*) :: name - - dycore_is = .false. - if (name == 'unstructured' .or. name == 'UNSTRUCTURED' .or. name == 'fv3' .or. name == 'FV3') then - dycore_is = .true. - end if - - return -end function dycore_is - -end module dycore diff --git a/src/dynamics/fv3/dycore_budget.F90 b/src/dynamics/fv3/dycore_budget.F90 deleted file mode 100644 index 0645edb251..0000000000 --- a/src/dynamics/fv3/dycore_budget.F90 +++ /dev/null @@ -1,27 +0,0 @@ -module dycore_budget - -implicit none - -public :: print_budget - -!========================================================================================= -contains -!========================================================================================= - -subroutine print_budget(hstwr) - - use spmd_utils, only: masterproc - use cam_abortutils, only: endrun - use cam_budget, only: thermo_budget_histfile_num, thermo_budget_history - - ! arguments - logical, intent(in) :: hstwr(:) - character(len=*), parameter :: subname = 'dycore_budget:print_budgets:' - - !-------------------------------------------------------------------------------------- - - if (masterproc .and. thermo_budget_history .and. hstwr(thermo_budget_histfile_num)) then - call endrun(subname//' is not implemented for the FV3 dycore') - end if -end subroutine print_budget -end module dycore_budget diff --git a/src/dynamics/fv3/dyn_comp.F90 b/src/dynamics/fv3/dyn_comp.F90 deleted file mode 100644 index 941b2742b1..0000000000 --- a/src/dynamics/fv3/dyn_comp.F90 +++ /dev/null @@ -1,2227 +0,0 @@ -module dyn_comp -! CAM interfaces to the GFDL FV3 Dynamical Core - -!----------------------------------------------------------------------- -! Five prognostic state variables for the fv3 dynamics -!----------------------------------------------------------------------- -! dyn_state: -! D-grid prognostatic variables: u, v, and delp (and other scalars) -! -! o--------u(i,j+1)----------o -! | | | -! | | | -! v(i,j)------scalar(i,j)----v(i+1,j) -! | | | -! | | | -! o--------u(i,j)------------o -! -! The C grid component is "diagnostic" in that it is predicted every time step -! from the D grid variables. -!---------------------------------------------------------------------- -! hydrostatic state: -!---------------------------------------------------------------------- -! u ! D grid zonal wind (m/s) -! v ! D grid meridional wind (m/s) -! p ! temperature (K) -! delp ! pressure thickness (pascal) -! q ! specific humidity and prognostic constituents -! qdiag ! diagnostic tracers -!---------------------------------------------------------------------- -! additional non-hydrostatic state: -!---------------------------------------------------------------------- -! w ! cell center vertical wind (m/s) -! delz ! layer thickness (meters) -! ze0 ! height at layer edges for remapping -! q_con ! total condensates -! -!---------------------------------------------------------------------- -!---------------------------------------------------------------------- - - - - use cam_abortutils, only: endrun - use cam_logfile, only: iulog - use constants_mod, only: cp_air, kappa, rvgas, rdgas - use constituents, only: pcnst, cnst_name, cnst_longname, tottnam - use dimensions_mod, only: npx, npy, nlev, & - cnst_name_ffsl,cnst_longname_ffsl, & - fv3_lcp_moist,fv3_lcv_moist,qsize_tracer_idx_cam2dyn,fv3_scale_ttend - use dyn_grid, only: mytile, ini_grid_name - use field_manager_mod, only: MODEL_ATMOS - use fms_io_mod, only: set_domain, nullify_domain - use fv_arrays_mod, only: fv_atmos_type, fv_grid_bounds_type - use fv_grid_utils_mod,only: cubed_to_latlon, g_sum - use fv_nesting_mod, only: twoway_nesting - use infnan, only: isnan - use mpp_domains_mod, only: mpp_update_domains, domain2D, DGRID_NE - use mpp_mod, only: mpp_set_current_pelist,mpp_pe - use physconst, only: gravit, cpair, rearth, omega, pi - use ppgrid, only: pver - use shr_kind_mod, only: r8 => shr_kind_r8, r4 => shr_kind_r4, i8 => shr_kind_i8 - use spmd_utils, only: masterproc, masterprocid, mpicom, npes,iam - use spmd_utils, only: mpi_integer, mpi_logical - use tracer_manager_mod, only: get_tracer_index - - implicit none - private - save - - public :: & - dyn_init, & - dyn_run, & - dyn_final, & - dyn_readnl, & - dyn_register, & - dyn_import_t, & - dyn_export_t - - public calc_tot_energy_dynamics - -type dyn_import_t - type (fv_atmos_type), pointer :: Atm(:) => null() - integer, pointer :: mygindex(:,:) => null() - integer, pointer :: mylindex(:,:) => null() -end type dyn_import_t - -type dyn_export_t - type (fv_atmos_type), pointer :: Atm(:) => null() -end type dyn_export_t - -! Private interfaces -interface read_dyn_var - module procedure read_dyn_field_2d - module procedure read_dyn_field_3d -end interface read_dyn_var - -real(r8), public, allocatable, dimension(:,:,:) :: u_dt, v_dt, t_dt - -!These are convenience variables for local use only, and are set to values in Atm% -real(r8) :: zvir, dt_atmos_real - -integer :: ldof_size - -real(r8), allocatable,dimension(:,:,:) :: se_dyn,ke_dyn,wv_dyn,wl_dyn,wi_dyn, & - wr_dyn,ws_dyn,wg_dyn,tt_dyn,mo_dyn,mr_dyn - -real(r8), parameter :: rad2deg = 180.0_r8 / pi -real(r8), parameter :: deg2rad = pi / 180.0_r8 - -!======================================================================= -contains -!======================================================================= -subroutine dyn_readnl(nlfilename) - - ! Read dynamics namelist group from atm_in and write to fv3 input.nml file - use namelist_utils, only: find_group_name - use constituents, only: pcnst - - ! args - character(len=*), intent(in) :: nlfilename - - ! Local variables - integer :: unitn,unito, ierr,i,ios - - ! FV3 Namelist variables - integer :: fv3_npes - - ! fv_core namelist variables - these namelist variables defined in fv3 library without fv3_ - - integer :: fv3_consv_te, fv3_dnats, fv3_fv_sg_adj, fv3_grid_type, & - fv3_hord_dp, fv3_hord_mt, fv3_hord_tm, fv3_hord_tr, fv3_hord_vt, & - fv3_io_layout(2), fv3_k_split, fv3_kord_mt, fv3_kord_tm, fv3_kord_tr, & - fv3_kord_wz, fv3_layout(2), fv3_n_split, fv3_n_sponge, fv3_na_init, & - fv3_ncnst, fv3_nord, fv3_npx, fv3_npy, fv3_npz, fv3_ntiles, & - fv3_nwat, fv3_print_freq - - real(r8) :: fv3_beta, fv3_d2_bg, fv3_d2_bg_k1, fv3_d2_bg_k2, fv3_d4_bg, & - fv3_d_con, fv3_d_ext, fv3_dddmp, fv3_delt_max, fv3_ke_bg, & - fv3_rf_cutoff, fv3_tau, fv3_vtdm4 - - logical :: fv3_adjust_dry_mass, fv3_consv_am, fv3_do_sat_adj, fv3_do_vort_damp, & - fv3_dwind_2d, fv3_fill, fv3_fv_debug, fv3_fv_diag, fv3_hydrostatic, & - fv3_make_nh, fv3_no_dycore, fv3_range_warn - - ! fms_nml namelist variables - these namelist variables defined in fv3 library without fv3_ - - character(len=256) :: fv3_clock_grain - integer :: fv3_domains_stack_size - integer :: fv3_stack_size - logical :: fv3_print_memory_usage - - character(len=256) :: inrec ! first 80 characters of input record - character(len=256) :: inrec2 ! left adjusted input record - - character(len = 20), dimension(5) :: group_names = (/ & - "main_nml ", & - "fv_core_nml ", & - "surf_map_nml ", & - "test_case_nml ", & - "fms_nml "/) - - namelist /fms_nml/ & - fv3_clock_grain, & - fv3_domains_stack_size, & - fv3_print_memory_usage, & - fv3_stack_size - - namelist /dyn_fv3_inparm/ & - fv3_scale_ttend, & - fv3_lcp_moist, & - fv3_lcv_moist, & - fv3_npes - - namelist /fv_core_nml/ & - fv3_adjust_dry_mass,fv3_beta,fv3_consv_am,fv3_consv_te,fv3_d2_bg, & - fv3_d2_bg_k1,fv3_d2_bg_k2,fv3_d4_bg,fv3_d_con,fv3_d_ext,fv3_dddmp, & - fv3_delt_max,fv3_dnats,fv3_do_sat_adj,fv3_do_vort_damp,fv3_dwind_2d, & - fv3_fill,fv3_fv_debug,fv3_fv_diag,fv3_fv_sg_adj,fv3_grid_type, & - fv3_hord_dp,fv3_hord_mt,fv3_hord_tm,fv3_hord_tr,fv3_hord_vt, & - fv3_hydrostatic,fv3_io_layout,fv3_k_split,fv3_ke_bg,fv3_kord_mt, & - fv3_kord_tm,fv3_kord_tr,fv3_kord_wz,fv3_layout,fv3_make_nh, & - fv3_n_split,fv3_n_sponge,fv3_na_init,fv3_ncnst,fv3_no_dycore, & - fv3_nord,fv3_npx,fv3_npy,fv3_npz,fv3_ntiles,fv3_nwat, & - fv3_print_freq,fv3_range_warn,fv3_rf_cutoff,fv3_tau, & - fv3_vtdm4 - !-------------------------------------------------------------------------- - - ! defaults for namelist variables not set by build-namelist - fv3_npes = npes - - if (masterproc) then - ! Read the namelist (dyn_fv3_inparm) - open( newunit=unitn, file=trim(NLFileName), status='old' ) - call find_group_name(unitn, 'dyn_fv3_inparm', status=ierr) - if (ierr == 0) then - read(unitn, dyn_fv3_inparm, iostat=ierr) - if (ierr /= 0) then - call endrun('dyn_readnl: ERROR reading dyn_fv3_inparm namelist') - end if - end if - close(unitn) - ! Read the namelist (fms_nml) - open( newunit=unitn, file=trim(NLFileName), status='old' ) - call find_group_name(unitn, 'fms_nml', status=ierr) - if (ierr == 0) then - read(unitn, fms_nml, iostat=ierr) - if (ierr /= 0) then - call endrun('dyn_readnl: ERROR reading fms_nml namelist') - end if - end if - close(unitn) - ! Read the namelist (fv_core_nml) - open( newunit=unitn, file=trim(NLFileName), status='old' ) - call find_group_name(unitn, 'fv_core_nml', status=ierr) - if (ierr == 0) then - read(unitn, fv_core_nml, iostat=ierr) - if (ierr /= 0) then - call endrun('dyn_readnl: ERROR reading fv_core_nml namelist') - end if - end if - close(unitn) - end if - - ! Broadcast namelist values to all PEs - call MPI_bcast(fv3_npes, 1, mpi_integer, masterprocid, mpicom, ierr) - call MPI_bcast(fv3_scale_ttend, 1, mpi_logical, masterprocid, mpicom, ierr) - call MPI_bcast(fv3_lcv_moist, 1, mpi_logical, masterprocid, mpicom, ierr) - call MPI_bcast(fv3_lcp_moist, 1, mpi_logical, masterprocid, mpicom, ierr) - - if ((fv3_lcp_moist.eqv.fv3_lcv_moist) .and. (fv3_lcv_moist.eqv..true.)) then - call endrun('dyn_readnl: fv3_lcp_moist and fv3_lcv_moist can not both be true') - endif - - if (fv3_npes <= 0) then - call endrun('dyn_readnl: ERROR: fv3_npes must be > 0') - end if - - ! - ! write fv3 dycore namelist options to log - ! - if (masterproc) then - write (iulog,*) 'FV3 dycore Options: ' - write (iulog,*) ' fv3_adjust_dry_mass = ',fv3_adjust_dry_mass - write (iulog,*) ' fv3_beta = ',fv3_beta - write (iulog,*) ' fv3_clock_grain = ',trim(fv3_clock_grain) - write (iulog,*) ' fv3_consv_am = ',fv3_consv_am - write (iulog,*) ' fv3_consv_te = ',fv3_consv_te - write (iulog,*) ' fv3_d2_bg = ',fv3_d2_bg - write (iulog,*) ' fv3_d2_bg_k1 = ',fv3_d2_bg_k1 - write (iulog,*) ' fv3_d2_bg_k2 = ',fv3_d2_bg_k2 - write (iulog,*) ' fv3_d4_bg = ',fv3_d4_bg - write (iulog,*) ' fv3_d_con = ',fv3_d_con - write (iulog,*) ' fv3_d_ext = ',fv3_d_ext - write (iulog,*) ' fv3_dddmp = ',fv3_dddmp - write (iulog,*) ' fv3_delt_max = ',fv3_delt_max - write (iulog,*) ' fv3_dnats = ',fv3_dnats - write (iulog,*) ' fv3_do_sat_adj = ',fv3_do_sat_adj - write (iulog,*) ' fv3_do_vort_damp = ',fv3_do_vort_damp - write (iulog,*) ' fv3_dwind_2d = ',fv3_dwind_2d - write (iulog,*) ' fv3_fill = ',fv3_fill - write (iulog,*) ' fv3_fv_debug = ',fv3_fv_debug - write (iulog,*) ' fv3_fv_diag = ',fv3_fv_diag - write (iulog,*) ' fv3_fv_sg_adj = ',fv3_fv_sg_adj - write (iulog,*) ' fv3_grid_type = ',fv3_grid_type - write (iulog,*) ' fv3_hord_dp = ',fv3_hord_dp - write (iulog,*) ' fv3_hord_mt = ',fv3_hord_mt - write (iulog,*) ' fv3_hord_tm = ',fv3_hord_tm - write (iulog,*) ' fv3_hord_tr = ',fv3_hord_tr - write (iulog,*) ' fv3_hord_vt = ',fv3_hord_vt - write (iulog,*) ' fv3_hydrostatic = ',fv3_hydrostatic - write (iulog,*) ' fv3_io_layout = ',fv3_io_layout - write (iulog,*) ' fv3_k_split = ',fv3_k_split - write (iulog,*) ' fv3_ke_bg = ',fv3_ke_bg - write (iulog,*) ' fv3_kord_mt = ',fv3_kord_mt - write (iulog,*) ' fv3_kord_tm = ',fv3_kord_tm - write (iulog,*) ' fv3_kord_tr = ',fv3_kord_tr - write (iulog,*) ' fv3_kord_wz = ',fv3_kord_wz - write (iulog,*) ' fv3_layout = ',fv3_layout - write (iulog,*) ' fv3_lcp_moist = ',fv3_lcp_moist - write (iulog,*) ' fv3_lcv_moist = ',fv3_lcv_moist - write (iulog,*) ' fv3_make_nh = ',fv3_make_nh - write (iulog,*) ' fv3_n_split = ',fv3_n_split - write (iulog,*) ' fv3_n_sponge = ',fv3_n_sponge - write (iulog,*) ' fv3_na_init = ',fv3_na_init - write (iulog,*) ' fv3_ncnst = ',fv3_ncnst - write (iulog,*) ' fv3_no_dycore = ',fv3_no_dycore - write (iulog,*) ' fv3_nord = ',fv3_nord - write (iulog,*) ' fv3_npx = ',fv3_npx - write (iulog,*) ' fv3_npy = ',fv3_npy - write (iulog,*) ' fv3_npz = ',fv3_npz - write (iulog,*) ' fv3_ntiles = ',fv3_ntiles - write (iulog,*) ' fv3_nwat = ',fv3_nwat - write (iulog,*) ' fv3_print_freq = ',fv3_print_freq - write (iulog,*) ' fv3_domains_stack_size = ',fv3_domains_stack_size - write (iulog,*) ' fv3_range_warn = ',fv3_range_warn - write (iulog,*) ' fv3_rf_cutoff = ',fv3_rf_cutoff - write (iulog,*) ' fv3_scale_ttend = ',fv3_scale_ttend - write (iulog,*) ' fv3_stack_size = ',fv3_stack_size - write (iulog,*) ' fv3_tau = ',fv3_tau - write (iulog,*) ' fv3_vtdm4 = ',fv3_vtdm4 - end if - - ! Create the input.nml namelist needed by the fv3dycore. - ! Read strings one at a time from the fv3 namelist groups, - ! strip off the leading 'fv3_' from the variable names and write to input.nml. - ! This could be replaced by also by writing to the internal namelist file - - if (masterproc) then - - write(iulog,*) 'Creating fv3 input.nml file from atm_in fv3_xxx namelist parameters' - ! Read the namelist (main_nml) - ! open the file input.nml - ! overwrite file if it exists. - open( newunit=unito, file='input.nml', status='replace' ) - - open( newunit=unitn, file=trim(NLFileName), status='old' ) - - do i=1,SIZE(group_names(:)) - rewind(unitn) - call find_group_name(unitn, trim(group_names(i)), status=ierr) - - if (ierr == 0) then ! Found it. Copy each line to input.nml until '/' is encountered. - - ! write group name to input.nml - read(unitn, '(a)', iostat=ios, end=100) inrec - if (ios /= 0) call endrun('ERROR: dyn_readnl - error reading fv3 namelist') - write(unito,'(a)') trim(inrec) - - ios = 0 - do while (ios <= 0) - - read(unitn, '(a)', iostat=ios, end=100) inrec - - if (ios <= 0) then ! ios < 0 indicates an end of record condition - - ! remove leading blanks and check for leading '/' - inrec2 = adjustl(inrec) - if (inrec2(1:4) == 'fv3_') then - inrec2(1:4) = ' ' - end if - write(unito,'(a)') trim(inrec2) - if (inrec2(1:1) == '/') exit - end if - end do - end if - end do - close(unitn) - close(unito) - end if - return -100 continue - call endrun('ERROR: dyn_readnl: End of file encountered while reading fv3 namelist groups') - -end subroutine dyn_readnl - -!============================================================================================= - -subroutine dyn_register() - - ! These fields are computed by the dycore and passed to the physics via the - ! physics buffer. - -end subroutine dyn_register - -!============================================================================================= - -subroutine dyn_init(dyn_in, dyn_out) - - ! DESCRIPTION: Initialize the FV dynamical core - - ! Initialize FV dynamical core state variables - - - use cam_control_mod, only: initial_run - use cam_history, only: addfld, horiz_only - use cam_history, only: register_vector_field - use cam_pio_utils, only: clean_iodesc_list - use dyn_grid, only: Atm,mygindex,mylindex - use fv_diagnostics_mod, only: fv_diag_init - use fv_mp_mod, only: fill_corners, YDir, switch_current_Atm - use infnan, only: inf, assignment(=) - use physconst, only: cpwv, cpliq, cpice, rair, cpair - use air_composition, only: thermodynamic_active_species_num, dry_air_species_num, thermodynamic_active_species_idx - use air_composition, only: thermodynamic_active_species_idx_dycore - use tracer_manager_mod, only: register_tracers - use dyn_tests_utils, only: vc_dycore, vc_moist_pressure, string_vc, vc_str_lgth - ! arguments: - type (dyn_import_t), intent(out) :: dyn_in - type (dyn_export_t), intent(out) :: dyn_out - - ! Locals - character(len=*), parameter :: subname='dyn_init' - real(r8) :: alpha - - - real(r8), pointer, dimension(:,:) :: fC,f0 ! Coriolis parameters - real(r8), pointer, dimension(:,:,:) :: grid,agrid,delp - logical, pointer :: cubed_sphere - type(domain2d), pointer :: domain - integer :: i,j,m - - ! variables for initializing energy and axial angular momentum diagnostics - character (len = 3), dimension(8) :: stage = (/"dED","dAP","dBD","dAT","dAF","dAD","dAR","dBF"/) - character (len = 70),dimension(8) :: stage_txt = (/& - " end of previous dynamics ",& !dED - " after physics increment on A-grid ",& !dAP - " state after applying CAM forcing ",& !dBD - state after applyCAMforcing - " state after top of atmosphere damping (Rayleigh) ",& !dAT - " from previous remapping or state passed to dynamics",& !dAF - state in beginning of ksplit loop - " before vertical remapping ",& !dAD - state before vertical remapping - " after vertical remapping ",& !dAR - state at end of nsplit loop - " state passed to parameterizations " & !dBF - /) - character (len = 2) , dimension(11) :: vars = (/"WV","WL","WI","WR","WS","WG","SE","KE","MR","MO","TT"/) - character (len = 70), dimension(11) :: vars_descriptor = (/& - "Total column water vapor ",& - "Total column cloud water ",& - "Total column cloud ice ",& - "Total column rain ",& - "Total column snow ",& - "Total column graupel ",& - "Total column dry static energy ",& - "Total column kinetic energy ",& - "Total column wind axial angular momentum",& - "Total column mass axial angular momentum",& - "Total column test tracer "/) - character (len = 14), dimension(11) :: & - vars_unit = (/& - "kg/m2 ","kg/m2 ","kg/m2 ", & - "kg/m2 ","kg/m2 ","kg/m2 ","J/m2 ",& - "J/m2 ","kg*m2/s*rad2 ","kg*m2/s*rad2 ","kg/m2 "/) - - integer :: istage, ivars - character (len=108) :: str1, str2, str3 - character (len=vc_str_lgth) :: vc_str - integer :: is,isd,ie,ied,js,jsd,je,jed - integer :: fv3idx,idx - - integer :: unito - integer, parameter :: ndiag = 5 - integer :: ncnst, pnats, num_family, nt_prog - character(len=128) :: errmsg - logical :: wet_thermo_species - !----------------------------------------------------------------------- - vc_dycore = vc_moist_pressure - if (masterproc) then - call string_vc(vc_dycore,vc_str) - write(iulog,*) subname//': vertical coordinate dycore : ',trim(vc_str) - end if - ! Setup the condensate loading arrays and fv3/cam tracer mapping and - ! finish initializing fv3 by allocating the tracer arrays in the fv3 atm structure - - allocate(qsize_tracer_idx_cam2dyn(pcnst)) - qsize_tracer_idx_cam2dyn(:)=-1 - allocate(cnst_name_ffsl(pcnst)) ! constituent names for ffsl tracers - allocate(cnst_longname_ffsl(pcnst)) ! long name of constituents for ffsl tracers - - - ! set up the condensate loading array - if (thermodynamic_active_species_num - dry_air_species_num > 6) then - call endrun(subname//': fv3_thermodynamic_active_species_num is limited to 6 wet condensates') - end if - - !For FV3 Q must be the first species in the fv3 tracer array followed by wet constituents - idx=1 - do m=1,pcnst - if ( trim(cnst_name(m)) == 'Q'.or.& - trim(cnst_name(m)) == 'CLDLIQ'.or.& - trim(cnst_name(m)) == 'CLDICE'.or.& - trim(cnst_name(m)) == 'RAINQM'.or.& - trim(cnst_name(m)) == 'SNOWQM'.or.& - trim(cnst_name(m)) == 'GRAUQM') then - idx=idx+1 - wet_thermo_species=any(thermodynamic_active_species_idx(dry_air_species_num+1:thermodynamic_active_species_num)==m) - select case ( trim(cnst_name(m)) ) - case ( 'Q' ) - idx=idx-1 - cnst_name_ffsl(1)='sphum' - cnst_longname_ffsl(1) = cnst_longname(m) - qsize_tracer_idx_cam2dyn(m) = 1 - if (wet_thermo_species) thermodynamic_active_species_idx_dycore(1)=1 - case ( 'CLDLIQ' ) - cnst_name_ffsl(idx)='liq_wat' - case ( 'CLDICE' ) - cnst_name_ffsl(idx)='ice_wat' - case ( 'RAINQM' ) - cnst_name_ffsl(idx)='rainwat' - case ( 'SNOWQM' ) - cnst_name_ffsl(idx)='snowwat' - case ( 'GRAUQM' ) - cnst_name_ffsl(idx)='graupel' - end select - - if (trim(cnst_name(m))/='Q') then - if (wet_thermo_species) thermodynamic_active_species_idx_dycore(idx)=idx - cnst_longname_ffsl(idx) = cnst_longname(m) - qsize_tracer_idx_cam2dyn(m) = idx - end if - end if - end do - - do m=1,pcnst - if ( trim(cnst_name(m)) /= 'Q'.and.& - trim(cnst_name(m)) /= 'CLDLIQ'.and.& - trim(cnst_name(m)) /= 'CLDICE'.and.& - trim(cnst_name(m)) /= 'RAINQM'.and.& - trim(cnst_name(m)) /= 'SNOWQM'.and.& - trim(cnst_name(m)) /= 'GRAUQM') then - idx=idx+1 - cnst_name_ffsl(idx)=cnst_name(m) - cnst_longname_ffsl(idx) = cnst_longname(m) - qsize_tracer_idx_cam2dyn(m) = idx - end if - end do - - if (masterproc) then - - write(iulog,*) subname//': Creating field_table file to load tracer fields into fv3' - ! overwrite file if it exists. - open( newunit=unito, file='field_table', status='replace' ) - do i=1,pcnst - write(unito, '(a,a,a)') '"tracer" "atmos_mod" "'//trim(cnst_name_ffsl(i))//'" /' - end do - close(unito) - end if - !---------must make sure the field_table file is written before reading across processors - call mpibarrier (mpicom) - call register_tracers (MODEL_ATMOS, ncnst, nt_prog, pnats, num_family) - if (ncnst /= pcnst) then - call endrun(subname//': ERROR: FMS tracer Manager has inconsistent tracer numbers') - endif - - do m=1,pcnst - ! just check condensate loading tracers as they are mapped above - if(qsize_tracer_idx_cam2dyn(m) <= thermodynamic_active_species_num-dry_air_species_num) then - fv3idx = get_tracer_index (MODEL_ATMOS, cnst_name_ffsl(qsize_tracer_idx_cam2dyn(m)) ) - if (fv3idx /= qsize_tracer_idx_cam2dyn(m)) then - write(errmsg,*) subname//': Physics index ',m,'and FV3 tracer index',fv3idx,' are inconsistent' - call endrun(errmsg) - end if - end if - end do - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - isd = Atm(mytile)%bd%isd - ied = Atm(mytile)%bd%ied - jsd = Atm(mytile)%bd%jsd - jed = Atm(mytile)%bd%jed - - ! Data initialization - dyn_in%Atm => Atm - dyn_in%mygindex => mygindex - dyn_in%mylindex => mylindex - dyn_out%Atm => Atm - - allocate(u_dt(isd:ied,jsd:jed,nlev)) - allocate(v_dt(isd:ied,jsd:jed,nlev)) - allocate(t_dt(isd:ied,jsd:jed,nlev)) - u_dt(:,:,:) = 0._r8 - v_dt(:,:,:) = 0._r8 - t_dt(:,:,:) = 0._r8 - - fC => atm(mytile)%gridstruct%fC - f0 => atm(mytile)%gridstruct%f0 - grid => atm(mytile)%gridstruct%grid_64 - agrid => atm(mytile)%gridstruct%agrid_64 - domain=> Atm(mytile)%domain - cubed_sphere => atm(mytile)%gridstruct%cubed_sphere - delp => Atm(mytile)%delp - - ! initialize Coriolis parameters which are used in sw_core. - f0(:,:) = inf - fC(:,:) = inf - alpha = 0._r8 - - do j=jsd,jed+1 - do i=isd,ied+1 - fC(i,j) = 2._r8*omega*( -1._r8*cos(grid(i,j,1))*cos(grid(i,j,2))*sin(alpha) + & - sin(grid(i,j,2))*cos(alpha) ) - enddo - enddo - do j=jsd,jed - do i=isd,ied - f0(i,j) = 2._r8*omega*( -1._r8*cos(agrid(i,j,1))*cos(agrid(i,j,2))*sin(alpha) + & - sin(agrid(i,j,2))*cos(alpha) ) - enddo - enddo - call mpp_update_domains( f0, domain ) - if (cubed_sphere) call fill_corners(f0, npx, npy, YDir) - - delp(isd:is-1,jsd:js-1,1:nlev)=0._r8 - delp(isd:is-1,je+1:jed,1:nlev)=0._r8 - delp(ie+1:ied,jsd:js-1,1:nlev)=0._r8 - delp(ie+1:ied,je+1:jed,1:nlev)=0._r8 - - if (initial_run) then - - ! Read in initial data - call read_inidat(dyn_in) - call clean_iodesc_list() - - end if - - call switch_current_Atm(Atm(mytile)) - call set_domain ( Atm(mytile)%domain ) - - ! Forcing from physics on the FFSL grid - call addfld ('FU', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind forcing term on FFSL grid', gridname='FFSLHIST') - call addfld ('FV', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind forcing term on FFSL grid',gridname='FFSLHIST') - call register_vector_field('FU', 'FV') - call addfld ('FT', (/ 'lev' /), 'A', 'K/s', 'Temperature forcing term on FFSL grid',gridname='FFSLHIST') - - do m = 1, pcnst - call addfld ('F'//trim(cnst_name_ffsl(m))//'_ffsl', (/ 'lev' /), 'I', 'kg/kg/s', & - trim(cnst_longname(m))//' mixing ratio forcing term (q_new-q_old) on FFSL grid', gridname='FFSLHIST') - call addfld(tottnam(m),(/ 'lev' /),'A','kg/kg/s', & - trim(cnst_name_ffsl(m))//' horz + vert + fixer tendency ', & - gridname='FFSLHIST') - end do - - ! Energy diagnostics and axial angular momentum diagnostics - do istage = 1,SIZE(stage) - do ivars=1,SIZE(vars) - write(str1,*) TRIM(ADJUSTL(vars(ivars))),TRIM(ADJUSTL("_")),TRIM(ADJUSTL(stage(istage))) - write(str2,*) TRIM(ADJUSTL(vars_descriptor(ivars))),& - TRIM(ADJUSTL(" ")),TRIM(ADJUSTL(stage_txt(istage))) - write(str3,*) TRIM(ADJUSTL(vars_unit(ivars))) - call addfld (TRIM(ADJUSTL(str1)),horiz_only,'A',TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & - gridname='FFSLHIST') - end do - end do - - allocate(se_dyn(is:ie,js:je,ndiag)) - allocate(ke_dyn(is:ie,js:je,ndiag)) - allocate(wv_dyn(is:ie,js:je,ndiag)) - allocate(wl_dyn(is:ie,js:je,ndiag)) - allocate(wi_dyn(is:ie,js:je,ndiag)) - allocate(wr_dyn(is:ie,js:je,ndiag)) - allocate(ws_dyn(is:ie,js:je,ndiag)) - allocate(wg_dyn(is:ie,js:je,ndiag)) - allocate(tt_dyn(is:ie,js:je,ndiag)) - allocate(mr_dyn(is:ie,js:je,ndiag)) - allocate(mo_dyn(is:ie,js:je,ndiag)) - - -end subroutine dyn_init - -!======================================================================= - -subroutine dyn_run(dyn_state) - - ! DESCRIPTION: Driver for the NASA finite-volume dynamical core - - - use dimensions_mod, only: nlev - use dyn_grid, only: p_split,grids_on_this_pe - use fv_control_mod, only: ngrids - use fv_dynamics_mod, only: fv_dynamics - use fv_sg_mod, only: fv_subgrid_z - use air_composition, only: thermodynamic_active_species_num, thermodynamic_active_species_idx_dycore, & - thermodynamic_active_species_cp,thermodynamic_active_species_cv,dry_air_species_num - use time_manager, only: get_step_size - use tracer_manager_mod, only: get_tracer_index, NO_TRACER - - ! Arguments - type (dyn_export_t), intent(inout) :: dyn_state - - ! Locals - integer :: psc,idim - integer :: w_diff, nt_dyn - type(fv_atmos_type), pointer :: Atm(:) - integer :: is,isc,isd,ie,iec,ied,js,jsc,jsd,je,jec,jed - - !---- Call FV dynamics ----- - - Atm => dyn_state%Atm - - !----------------------------------------------------------------------- - - call mpp_set_current_pelist(Atm(mytile)%pelist, no_sync=.TRUE.) - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - isc = Atm(mytile)%bd%isc - iec = Atm(mytile)%bd%iec - jsc = Atm(mytile)%bd%jsc - jec = Atm(mytile)%bd%jec - isd = Atm(mytile)%bd%isd - ied = Atm(mytile)%bd%ied - jsd = Atm(mytile)%bd%jsd - jed = Atm(mytile)%bd%jed - - idim=ie-is+1 - - dt_atmos_real=get_step_size() - - se_dyn = 0._r8 - ke_dyn = 0._r8 - wv_dyn = 0._r8 - wl_dyn = 0._r8 - wi_dyn = 0._r8 - wr_dyn = 0._r8 - ws_dyn = 0._r8 - wg_dyn = 0._r8 - tt_dyn = 0._r8 - mo_dyn = 0._r8 - mr_dyn = 0._r8 - - zvir = rvgas/rdgas - 1._r8 - - Atm(mytile)%parent_grid => Atm(mytile) - - do psc=1,abs(p_split) - - call fv_dynamics(npx, npy, nlev, pcnst, Atm(mytile)%ng, dt_atmos_real/real(abs(p_split), r8),& - Atm(mytile)%flagstruct%consv_te, Atm(mytile)%flagstruct%fill, & - Atm(mytile)%flagstruct%reproduce_sum, kappa, cp_air, zvir,& - Atm(mytile)%ptop, Atm(mytile)%ks, pcnst, & - Atm(mytile)%flagstruct%n_split, Atm(mytile)%flagstruct%q_split,& - Atm(mytile)%u, Atm(mytile)%v, Atm(mytile)%w, Atm(mytile)%delz, & - Atm(mytile)%flagstruct%hydrostatic, & - Atm(mytile)%pt, Atm(mytile)%delp, Atm(mytile)%q, Atm(mytile)%ps, & - Atm(mytile)%pe, Atm(mytile)%pk, Atm(mytile)%peln, & - Atm(mytile)%pkz, Atm(mytile)%phis, Atm(mytile)%q_con, & - Atm(mytile)%omga, Atm(mytile)%ua, Atm(mytile)%va, Atm(mytile)%uc, & - Atm(mytile)%vc, Atm(mytile)%ak, Atm(mytile)%bk, Atm(mytile)%mfx, & - Atm(mytile)%mfy, Atm(mytile)%cx, Atm(mytile)%cy, Atm(mytile)%ze0, & - Atm(mytile)%flagstruct%hybrid_z, & - Atm(mytile)%gridstruct, Atm(mytile)%flagstruct, & - Atm(mytile)%neststruct, Atm(mytile)%idiag, Atm(mytile)%bd, & - Atm(mytile)%parent_grid, Atm(mytile)%domain, & -#if ( defined CALC_ENERGY ) - Atm(mytile)%diss_est, & - pcnst,thermodynamic_active_species_num,dry_air_species_num, & - thermodynamic_active_species_idx_dycore, qsize_tracer_idx_cam2dyn, & - thermodynamic_active_species_cp,thermodynamic_active_species_cv, se_dyn, ke_dyn, wv_dyn,wl_dyn, & - wi_dyn,wr_dyn,ws_dyn,wg_dyn,tt_dyn,mo_dyn,mr_dyn,gravit,cpair,rearth,omega,fv3_lcp_moist,& - fv3_lcv_moist) -#else - Atm(mytile)%diss_est) -#endif - - if (ngrids > 1 .and. (psc < p_split .or. p_split < 0)) then - call twoway_nesting(Atm, ngrids, grids_on_this_pe, zvir) - endif - - end do !p_split -#if ( defined CALC_ENERGY ) - call write_dyn_var(se_dyn(is:ie,js:je,1),'SE_dAF',Atm(mytile)%bd) - call write_dyn_var(ke_dyn(is:ie,js:je,1),'KE_dAF',Atm(mytile)%bd) - call write_dyn_var(wv_dyn(is:ie,js:je,1),'WV_dAF',Atm(mytile)%bd) - call write_dyn_var(wl_dyn(is:ie,js:je,1),'WL_dAF',Atm(mytile)%bd) - call write_dyn_var(wi_dyn(is:ie,js:je,1),'WI_dAF',Atm(mytile)%bd) - call write_dyn_var(wr_dyn(is:ie,js:je,1),'WR_dAF',Atm(mytile)%bd) - call write_dyn_var(ws_dyn(is:ie,js:je,1),'WS_dAF',Atm(mytile)%bd) - call write_dyn_var(wg_dyn(is:ie,js:je,1),'WG_dAF',Atm(mytile)%bd) - call write_dyn_var(tt_dyn(is:ie,js:je,1),'TT_dAF',Atm(mytile)%bd) - call write_dyn_var(mo_dyn(is:ie,js:je,1),'MO_dAF',Atm(mytile)%bd) - call write_dyn_var(mr_dyn(is:ie,js:je,1),'MR_dAF',Atm(mytile)%bd) - - call write_dyn_var(se_dyn(is:ie,js:je,2),'SE_dAD',Atm(mytile)%bd) - call write_dyn_var(ke_dyn(is:ie,js:je,2),'KE_dAD',Atm(mytile)%bd) - call write_dyn_var(wv_dyn(is:ie,js:je,2),'WV_dAD',Atm(mytile)%bd) - call write_dyn_var(wl_dyn(is:ie,js:je,2),'WL_dAD',Atm(mytile)%bd) - call write_dyn_var(wi_dyn(is:ie,js:je,2),'WI_dAD',Atm(mytile)%bd) - call write_dyn_var(wr_dyn(is:ie,js:je,2),'WR_dAD',Atm(mytile)%bd) - call write_dyn_var(ws_dyn(is:ie,js:je,2),'WS_dAD',Atm(mytile)%bd) - call write_dyn_var(wg_dyn(is:ie,js:je,2),'WG_dAD',Atm(mytile)%bd) - call write_dyn_var(tt_dyn(is:ie,js:je,2),'TT_dAD',Atm(mytile)%bd) - call write_dyn_var(mo_dyn(is:ie,js:je,2),'MO_dAD',Atm(mytile)%bd) - call write_dyn_var(mr_dyn(is:ie,js:je,2),'MR_dAD',Atm(mytile)%bd) - - call write_dyn_var(se_dyn(is:ie,js:je,3),'SE_dAR',Atm(mytile)%bd) - call write_dyn_var(ke_dyn(is:ie,js:je,3),'KE_dAR',Atm(mytile)%bd) - call write_dyn_var(wv_dyn(is:ie,js:je,3),'WV_dAR',Atm(mytile)%bd) - call write_dyn_var(wl_dyn(is:ie,js:je,3),'WL_dAR',Atm(mytile)%bd) - call write_dyn_var(wi_dyn(is:ie,js:je,3),'WI_dAR',Atm(mytile)%bd) - call write_dyn_var(wr_dyn(is:ie,js:je,3),'WR_dAR',Atm(mytile)%bd) - call write_dyn_var(ws_dyn(is:ie,js:je,3),'WS_dAR',Atm(mytile)%bd) - call write_dyn_var(wg_dyn(is:ie,js:je,3),'WG_dAR',Atm(mytile)%bd) - call write_dyn_var(tt_dyn(is:ie,js:je,3),'TT_dAR',Atm(mytile)%bd) - call write_dyn_var(mo_dyn(is:ie,js:je,3),'MO_dAR',Atm(mytile)%bd) - call write_dyn_var(mr_dyn(is:ie,js:je,3),'MR_dAR',Atm(mytile)%bd) - - call write_dyn_var(se_dyn(is:ie,js:je,4),'SE_dAT',Atm(mytile)%bd) - call write_dyn_var(ke_dyn(is:ie,js:je,4),'KE_dAT',Atm(mytile)%bd) - call write_dyn_var(wv_dyn(is:ie,js:je,4),'WV_dAT',Atm(mytile)%bd) - call write_dyn_var(wl_dyn(is:ie,js:je,4),'WL_dAT',Atm(mytile)%bd) - call write_dyn_var(wi_dyn(is:ie,js:je,4),'WI_dAT',Atm(mytile)%bd) - call write_dyn_var(wr_dyn(is:ie,js:je,4),'WR_dAT',Atm(mytile)%bd) - call write_dyn_var(ws_dyn(is:ie,js:je,4),'WS_dAT',Atm(mytile)%bd) - call write_dyn_var(wg_dyn(is:ie,js:je,4),'WG_dAT',Atm(mytile)%bd) - call write_dyn_var(tt_dyn(is:ie,js:je,4),'TT_dAT',Atm(mytile)%bd) - call write_dyn_var(mo_dyn(is:ie,js:je,4),'MO_dAT',Atm(mytile)%bd) - call write_dyn_var(mr_dyn(is:ie,js:je,4),'MR_dAT',Atm(mytile)%bd) -#endif - - !----------------------------------------------------- - !--- COMPUTE SUBGRID Z - !----------------------------------------------------- - !--- zero out tendencies - u_dt(:,:,:) = 0._r8 - v_dt(:,:,:) = 0._r8 - t_dt(:,:,:) = 0._r8 - - w_diff = get_tracer_index (MODEL_ATMOS, 'w_diff' ) - - ! Perform grid-scale dry adjustment if fv_sg_adj > 0 - if ( Atm(mytile)%flagstruct%fv_sg_adj > 0 ) then - nt_dyn = pcnst - if ( w_diff /= NO_TRACER ) then - nt_dyn = pcnst - 1 - endif - call fv_subgrid_z(isd, ied, jsd, jed, isc, iec, jsc, jec, nlev, & - nt_dyn, dt_atmos_real, Atm(mytile)%flagstruct%fv_sg_adj, & - Atm(mytile)%flagstruct%nwat, Atm(mytile)%delp, Atm(mytile)%pe, & - Atm(mytile)%peln, Atm(mytile)%pkz, Atm(mytile)%pt, Atm(mytile)%q, & - Atm(mytile)%ua, Atm(mytile)%va, Atm(mytile)%flagstruct%hydrostatic,& - Atm(mytile)%w, Atm(mytile)%delz, u_dt, v_dt, t_dt, Atm(mytile)%flagstruct%n_sponge) - endif - -#if ( defined CALC_ENERGY ) - call calc_tot_energy_dynamics(atm,'dBF') -#endif - -end subroutine dyn_run - -!======================================================================= - -subroutine dyn_final(dyn_in, dyn_out, restart_file) - - ! Arguments - type (dyn_import_t), intent(inout) :: dyn_in - type (dyn_export_t), intent(inout) :: dyn_out - character(len=*),optional,intent(in) :: restart_file - - !---------------------------------------------------------------------------- - - deallocate( u_dt, v_dt, t_dt) - -end subroutine dyn_final - -!============================================================================================= -! Private routines -!============================================================================================= - -subroutine read_inidat(dyn_in) - - use cam_control_mod, only: simple_phys - use inic_analytic, only: analytic_ic_active, analytic_ic_set_ic - use dyn_tests_utils, only: vc_moist_pressure,vc_dry_pressure - use dimensions_mod, only: nlev - use constituents, only: pcnst, cnst_is_a_water_species - use air_composition, only: thermodynamic_active_species_num, dry_air_species_num, thermodynamic_active_species_idx_dycore - use pio, only: file_desc_t, pio_seterrorhandling, pio_bcast_error - use ppgrid, only: pver - use cam_abortutils, only: endrun - use constituents, only: pcnst, cnst_name, cnst_read_iv,qmin, cnst_type - use const_init, only: cnst_init_default - use cam_initfiles, only: initial_file_get_id, topo_file_get_id, pertlim - use cam_grid_support, only: cam_grid_id, cam_grid_get_gcid, iMap, & - cam_grid_get_latvals, cam_grid_get_lonvals - use cam_history_support, only: max_fieldname_len - use hycoef, only: hyai, hybi, ps0 - use cam_initfiles, only: scale_dry_air_mass - - ! Arguments: - type (dyn_import_t), target, intent(inout) :: dyn_in ! dynamics import - - ! Locals: - logical :: found - - character(len = 40) :: fieldname,fieldname2 - - integer :: i, j, k, m, n - - type(file_desc_t), pointer :: fh_topo => null() - type(fv_atmos_type), pointer :: Atm(:) => null() - integer, pointer :: mylindex(:,:) => null() - integer, pointer :: mygindex(:,:) => null() - type(file_desc_t) :: fh_ini - - - character(len=*), parameter :: subname='READ_INIDAT' - - ! Variables for analytic initial conditions - integer, allocatable, dimension(:) :: glob_ind, m_ind,rndm_seed - integer :: is,ie,js,je,isd,ied,jsd,jed - integer :: blksize - integer :: indx - integer :: err_handling - integer :: m_cnst,m_cnst_ffsl - integer :: m_ffsl - integer :: ilen,jlen - integer :: num_wet_species! (wet species are first tracers in FV3 tracer array) - integer :: pio_errtype - integer :: rndm_seed_sz - integer :: vcoord - real(r8), pointer, dimension(:) :: latvals_deg(:) - real(r8), pointer, dimension(:) :: lonvals_deg(:) - real(r8), allocatable, dimension(:) :: latvals_rad, lonvals_rad - real(r8), allocatable, dimension(:,:) :: dbuf2 - real(r8), allocatable, dimension(:,:) :: pstmp - real(r8), allocatable, dimension(:,:) :: phis_tmp, var2d - real(r8), allocatable, dimension(:,:,:) :: dbuf3, var3d - real(r8), allocatable, dimension(:,:,:,:) :: dbuf4 - real(r8), pointer, dimension(:,:,:) :: agrid,grid - real(r8) :: pertval - real(r8) :: tracermass(pcnst),delpdry - real(r8) :: fv3_totwatermass, fv3_airmass - real(r8) :: reldif - logical :: inic_wet !initial condition is based on wet pressure and water species - - !----------------------------------------------------------------------- - - Atm => dyn_in%Atm - grid => Atm(mytile)%gridstruct%grid_64 - agrid => Atm(mytile)%gridstruct%agrid_64 - mylindex => dyn_in%mylindex - mygindex => dyn_in%mygindex - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - isd = Atm(mytile)%bd%isd - ied = Atm(mytile)%bd%ied - jsd = Atm(mytile)%bd%jsd - jed = Atm(mytile)%bd%jed - - fh_topo => topo_file_get_id() - fh_ini = initial_file_get_id() - - - ! Set mask to indicate which columns are active - ldof_size=(je-js+1)*(ie-is+1) - allocate(phis_tmp(ldof_size,1)) - phis_tmp(:,:)=0._r8 - - latvals_deg => cam_grid_get_latvals(cam_grid_id('FFSL')) - lonvals_deg => cam_grid_get_lonvals(cam_grid_id('FFSL')) - blksize=(ie-is+1)*(je-js+1) - - ! consistency check - if (blksize /= SIZE(latvals_deg)) then - call endrun(trim(subname)//': number of latitude values is inconsistent with dynamics block size.') - end if - - allocate(latvals_rad(blksize)) - allocate(lonvals_rad(blksize)) - latvals_rad(:) = latvals_deg(:)*deg2rad - lonvals_rad(:) = lonvals_deg(:)*deg2rad - - allocate(glob_ind(blksize)) - do j = js, je - do i = is, ie - n=mylindex(i,j) - glob_ind(n) = mygindex(i,j) - end do - end do - - ! Set ICs. Either from analytic expressions or read from file. - - if (analytic_ic_active()) then - vcoord = vc_moist_pressure - inic_wet = .true. - ! First, initialize all the variables, then assign - allocate(dbuf2(blksize,1)) - allocate(dbuf3(blksize,nlev,1)) - allocate(dbuf4(blksize,nlev, 1,pcnst)) - dbuf2 = 0.0_r8 - dbuf3 = 0.0_r8 - dbuf4 = 0.0_r8 - - allocate(m_ind(pcnst)) - do m_cnst = 1, pcnst - m_ind(m_cnst) = m_cnst - end do - - call analytic_ic_set_ic(vcoord, latvals_rad, lonvals_rad, glob_ind,PS=dbuf2) - do j = js, je - do i = is, ie - ! PS - n=mylindex(i,j) - atm(mytile)%ps(i,j) = dbuf2(n, 1) - end do - end do - - call analytic_ic_set_ic(vcoord, latvals_rad, lonvals_rad, glob_ind , & - PHIS_OUT=phis_tmp(:,:)) - - call analytic_ic_set_ic(vcoord, latvals_rad, lonvals_rad, glob_ind, & - T=dbuf3(:,:,:)) - - do j = js, je - do i = is, ie - ! T - n=mylindex(i,j) - atm(mytile)%pt(i,j,:) = dbuf3(n, :, 1) - end do - end do - - - dbuf3=0._r8 - call analytic_ic_set_ic(vcoord, latvals_rad, lonvals_rad, glob_ind, & - U=dbuf3(:,:,:)) - - do j = js, je - do i = is, ie - ! U a-grid - n=mylindex(i,j) - atm(mytile)%ua(i,j,:) = dbuf3(n, :, 1) - end do - end do - - dbuf3=0._r8 - call analytic_ic_set_ic(vcoord, latvals_rad, lonvals_rad, glob_ind, & - V=dbuf3(:,:,:)) - - do j = js, je - do i = is, ie - ! V a-grid - n=mylindex(i,j) - atm(mytile)%va(i,j,:) = dbuf3(n, :, 1) - end do - end do - - call analytic_ic_set_ic(vcoord, latvals_rad, lonvals_rad, glob_ind, & - Q=dbuf4(:,:,:,1:pcnst), m_cnst=m_ind) - - ! Tracers to be advected on FFSL grid. - do m_cnst = 1, pcnst - m_cnst_ffsl=qsize_tracer_idx_cam2dyn(m_cnst) - Atm(mytile)%q(:,:,:,m_cnst_ffsl) = 0.0_r8 - do j = js, je - do i = is, ie - indx=mylindex(i,j) - Atm(mytile)%q(i,j,:,m_cnst_ffsl) = dbuf4(indx, :, 1, m_cnst) - end do - end do - end do - - !----------------------------------------------------------------------- - call a2d3djt(atm(mytile)%ua, atm(mytile)%va, atm(mytile)%u, atm(mytile)%v, is, ie, js, je, & - isd, ied, jsd, jed, npx,npy, nlev, atm(mytile)%gridstruct, atm(mytile)%domain) - - deallocate(dbuf2) - deallocate(dbuf3) - deallocate(dbuf4) - deallocate(m_ind) - - else - ! Read ICs from file. - - allocate(dbuf3(blksize,nlev,1)) - allocate(var2d(is:ie,js:je)) - allocate(var3d(is:ie,js:je,nlev)) - - call pio_seterrorhandling(fh_ini, pio_bcast_error, err_handling) - ! PSDRY is unambiguous so use that field first if it exists and reset mixing ratios to - ! wet for FV3. PS (inic_wet) is assumed to be DRY+All wet condensates but could also be - ! DRY+Q (CAM physics) - fieldname = 'PSDRY' - fieldname2 = 'PS' - if (dyn_field_exists(fh_ini, trim(fieldname), required=.false.)) then - inic_wet = .false. - call read_dyn_var(trim(fieldname), fh_ini, 'ncol', var2d) - elseif (dyn_field_exists(fh_ini, trim(fieldname2), required=.false.)) then - inic_wet = .true. - call read_dyn_var(trim(fieldname2), fh_ini, 'ncol', var2d) - else - call endrun(trim(subname)//': PS or PSDRY must be on ncdata') - end if - atm(mytile)%ps(is:ie,js:je) = var2d - - ilen = ie-is+1 - jlen = je-js+1 - - ! T - if (dyn_field_exists(fh_ini, 'T')) then - call read_dyn_var('T', fh_ini, 'ncol', var3d) - atm(mytile)%pt(is:ie,js:je,1:nlev)=var3d(is:ie,js:je,1:nlev) - else - call endrun(trim(subname)//': T not found') - end if - - if (pertlim /= 0.0_r8) then - if(masterproc) then - write(iulog,*) trim(subname), ': Adding random perturbation bounded', & - 'by +/- ', pertlim, ' to initial temperature field' - end if - - call random_seed(size=rndm_seed_sz) - allocate(rndm_seed(rndm_seed_sz)) - - do i=is,ie - do j=js,je - indx=mylindex(i,j) - rndm_seed = glob_ind(indx) - call random_seed(put=rndm_seed) - do k=1,nlev - call random_number(pertval) - pertval = 2.0_r8*pertlim*(0.5_r8 - pertval) - atm(mytile)%pt(i,j,k) = atm(mytile)%pt(i,j,k)*(1.0_r8 + pertval) - end do - end do - end do - deallocate(rndm_seed) - end if - - ! V - if (dyn_field_exists(fh_ini, 'V')) then - call read_dyn_var('V', fh_ini, 'ncol', var3d) - atm(mytile)%va(is:ie,js:je,1:nlev)=var3d(is:ie,js:je,1:nlev) - else - call endrun(trim(subname)//': V not found') - end if - - if (dyn_field_exists(fh_ini, 'U')) then - call read_dyn_var('U', fh_ini, 'ncol', var3d) - atm(mytile)%ua(is:ie,js:je,1:nlev) =var3d(is:ie,js:je,1:nlev) - else - call endrun(trim(subname)//': U not found') - end if - - m_cnst=1 - if (dyn_field_exists(fh_ini, 'Q')) then - call read_dyn_var('Q', fh_ini, 'ncol', var3d) - atm(mytile)%q(is:ie,js:je,1:nlev,m_cnst) = var3d(is:ie,js:je,1:nlev) - else - call endrun(trim(subname)//': Q not found') - end if - - ! Read in or cold-initialize all the tracer fields - ! Copy tracers defined on unstructured grid onto distributed FFSL grid - ! Make sure tracers have at least minimum value - - do m_cnst = 2, pcnst - m_cnst_ffsl=qsize_tracer_idx_cam2dyn(m_cnst) - found = .false. - - if(cnst_read_iv(m_cnst)) then - found = dyn_field_exists(fh_ini, trim(cnst_name(m_cnst)), & - required=.false.) - end if - - if(found) then - call read_dyn_var(trim(cnst_name(m_cnst)), fh_ini, 'ncol', var3d) - atm(mytile)%q(is:ie,js:je,1:nlev,m_cnst_ffsl) = var3d(is:ie,js:je,1:nlev) - else - dbuf3=0._r8 - if (masterproc) write(iulog,*)'Missing ',trim(cnst_name(m_cnst)),' constituent number', & - m_cnst,size(latvals_rad),size(dbuf3) - if (masterproc) write(iulog,*)'Initializing ',trim(cnst_name(m_cnst)),'fv3 constituent number ',& - m_cnst_ffsl,' to default' - call cnst_init_default(m_cnst, latvals_rad, lonvals_rad, dbuf3) - do k=1, nlev - indx = 1 - do j = js, je - do i = is, ie - indx=mylindex(i,j) - atm(mytile)%q(i,j, k, m_cnst_ffsl) = max(qmin(m_cnst),dbuf3(indx,k,1)) - end do - end do - end do - end if - - end do ! pcnst - - call a2d3djt(atm(mytile)%ua, atm(mytile)%va, atm(mytile)%u, atm(mytile)%v, is, ie, js, je, & - isd, ied, jsd, jed, npx,npy, nlev, atm(mytile)%gridstruct, atm(mytile)%domain) - - ! Put the error handling back the way it was - call pio_seterrorhandling(fh_ini, err_handling) - - deallocate(dbuf3) - deallocate(var2d) - deallocate(var3d) - - end if ! analytic_ic_active - - deallocate(latvals_rad) - deallocate(lonvals_rad) - deallocate(glob_ind) - - ! If analytic ICs are being used, we allow constituents in an initial - ! file to overwrite mixing ratios set by the default constituent initialization - ! except for the water species. - - call pio_seterrorhandling(fh_ini, pio_bcast_error, err_handling) - allocate(var3d(is:ie,js:je,nlev)) - do m_cnst = 1, pcnst - m_cnst_ffsl=qsize_tracer_idx_cam2dyn(m_cnst) - - if (analytic_ic_active() .and. cnst_is_a_water_species(cnst_name(m_cnst))) cycle - - found = .false. - - if(cnst_read_iv(m_cnst)) then - found = dyn_field_exists(fh_ini, trim(cnst_name(m_cnst)), & - required=.false.) - end if - - if(found) then - call read_dyn_var(trim(cnst_name(m_cnst)), fh_ini, 'ncol', var3d) - atm(mytile)%q(is:ie,js:je,1:nlev,m_cnst_ffsl) = var3d(is:ie,js:je,1:nlev) - end if - end do - deallocate(var3d) - ! Put the error handling back the way it was - call pio_seterrorhandling(fh_ini, err_handling) - - ! If a topo file is specified use it. This will overwrite the PHIS set by the - ! analytic IC option. - ! - ! If using the physics grid then the topo file will be on that grid since its - ! contents are primarily for the physics parameterizations, and the values of - ! PHIS should be consistent with the values of sub-grid variability (e.g., SGH) - ! which are computed on the physics grid. - if (associated(fh_topo)) then - - ! We need to be able to see the PIO return values - call pio_seterrorhandling(fh_topo, PIO_BCAST_ERROR, pio_errtype) - - fieldname = 'PHIS' - if (dyn_field_exists(fh_topo, trim(fieldname))) then - call read_dyn_var(trim(fieldname), fh_topo, 'ncol', phis_tmp) - else - call endrun(trim(subname)//': ERROR: Could not find PHIS field on input datafile') - end if - - ! Put the error handling back the way it was - call pio_seterrorhandling(fh_topo, pio_errtype) - end if - - ! Process phis_tmp - atm(mytile)%phis = 0.0_r8 - do j = js, je - do i = is, ie - indx = mylindex(i,j) - atm(mytile)%phis(i,j) = phis_tmp(indx,1) - end do - end do - ! - ! initialize delp (and possibly mixing ratios) from IC fields. - ! - if (inic_wet) then - ! - ! /delp/mix ratios/ps consistent with fv3 airmass (dry+all wet tracers) assuming IC is CAM phys airmass (dry+q only) - ! - allocate(pstmp(isd:ied,jsd:jed)) - pstmp(:,:) = atm(mytile)%ps(:,:) - atm(mytile)%ps(:,:)=hyai(1)*ps0 - num_wet_species=thermodynamic_active_species_num-dry_air_species_num - do k=1,pver - do j = js, je - do i = is, ie - ! this delp is (dry+vap) using the moist ps read in. - Atm(mytile)%delp(i, j, k) = (((hyai(k+1) - hyai(k))*ps0) + & - ((hybi(k+1) - hybi(k))*pstmp(i,j))) - delpdry=Atm(mytile)%delp(i,j,k)*(1.0_r8-Atm(mytile)%q(i,j,k,1)) - do m=1,pcnst - m_ffsl=qsize_tracer_idx_cam2dyn(m) - if (cnst_type(m) == 'wet') then - tracermass(m_ffsl)=Atm(mytile)%delp(i,j,k)*Atm(mytile)%q(i,j,k,m_ffsl) - else - tracermass(m_ffsl)=delpdry*Atm(mytile)%q(i,j,k,m_ffsl) - end if - end do - fv3_totwatermass=sum(tracermass(thermodynamic_active_species_idx_dycore(1:num_wet_species))) - fv3_airmass = delpdry + fv3_totwatermass - Atm(mytile)%delp(i,j,k) = fv3_airmass - Atm(mytile)%q(i,j,k,1:pcnst) = tracermass(1:pcnst)/fv3_airmass - Atm(mytile)%ps(i,j)=Atm(mytile)%ps(i,j)+Atm(mytile)%delp(i, j, k) - end do - end do - end do - deallocate(pstmp) - else - ! - ! Make delp/mix ratios/ps consistent with fv3 airmass (dry+all wet constituents) assuming IC based off dry airmass - ! - allocate(pstmp(isd:ied,jsd:jed)) - pstmp(:,:) = atm(mytile)%ps(:,:) - atm(mytile)%ps(:,:)=hyai(1)*ps0 - num_wet_species=thermodynamic_active_species_num-dry_air_species_num - do k=1,pver - do j = js, je - do i = is, ie - ! this delp is assumed dry. - delpdry = (((hyai(k+1) - hyai(k))*ps0) + & - ((hybi(k+1) - hybi(k))*pstmp(i,j))) - do m=1,pcnst - tracermass(m)=delpdry*Atm(mytile)%q(i,j,k,m) - end do - fv3_totwatermass=sum(tracermass(thermodynamic_active_species_idx_dycore(1:num_wet_species))) - fv3_airmass = delpdry + fv3_totwatermass - Atm(mytile)%delp(i,j,k) = fv3_airmass - Atm(mytile)%q(i,j,k,1:pcnst) = tracermass(1:pcnst)/fv3_airmass - Atm(mytile)%ps(i,j)=Atm(mytile)%ps(i,j)+Atm(mytile)%delp(i, j, k) - ! check new tracermass - do m=1,pcnst - m_ffsl=qsize_tracer_idx_cam2dyn(m) - reldif=(Atm(mytile)%delp(i,j,k)*Atm(mytile)%q(i,j,k,m_ffsl)-tracermass(m_ffsl))/ & - tracermass(m_ffsl) - if (reldif > abs(1.0e-15_r8)) & - write(iulog,*)'mass inconsistency new, old, relative error=',iam,cnst_name(m), & - Atm(mytile)%delp(i,j,k)*Atm(mytile)%q(i,j,k,m_ffsl),tracermass(m_ffsl),reldif - end do - end do - end do - end do - deallocate(pstmp) - end if - ! - ! If scale_dry_air_mass > 0.0 then scale dry air mass to scale_dry_air_mass global average dry pressure - ! If scale_dry_air_mass = 0.0 don't scale - if (scale_dry_air_mass > 0.0_r8) then - call set_dry_mass(Atm, scale_dry_air_mass) - end if - - - !$omp parallel do private(i, j) - do j=js,je - do i=is,ie - Atm(mytile)%pe(i,1,j) = Atm(mytile)%ptop - Atm(mytile)%pk(i,j,1) = Atm(mytile)%ptop ** kappa - Atm(mytile)%peln(i,1,j) = log(Atm(mytile)%ptop ) - enddo - enddo - -!$omp parallel do private(i,j,k) - do j=js,je - do k=1,pver - do i=is,ie - Atm(mytile)%pe(i,k+1,j) = Atm(mytile)%pe(i,k,j) + Atm(mytile)%delp(i,j,k) - enddo - enddo - enddo - -!$omp parallel do private(i,j,k) - do j=js,je - do k=1,pver - do i=is,ie - Atm(mytile)%pk(i,j,k+1)= Atm(mytile)%pe(i,k+1,j) ** kappa - Atm(mytile)%peln(i,k+1,j) = log(Atm(mytile)%pe(i,k+1,j)) - Atm(mytile)%pkz(i,j,k) = (Atm(mytile)%pk(i,j,k+1)-Atm(mytile)%pk(i,j,k)) / & - (kappa*(Atm(mytile)%peln(i,k+1,j)-Atm(mytile)%peln(i,k,j))) - enddo - enddo - enddo -!! Initialize non hydrostatic variables if needed - if (.not. Atm(mytile)%flagstruct%hydrostatic) then - do k=1,nlev - do j=js,je - do i=is,ie - Atm(mytile)%w ( i,j,k ) = 0._r8 - Atm(mytile)%delz ( i,j,k ) = -rdgas/gravit*Atm(mytile)%pt( i,j,k ) * & - ( Atm(mytile)%peln( i,k+1,j ) - Atm(mytile)%peln( i,k,j ) ) - enddo - enddo - enddo - end if - - ! once we've read or initialized all the fields we call update_domains to - ! update the halo regions - - call mpp_update_domains( Atm(mytile)%phis, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%ps, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%u,atm(mytile)%v,Atm(mytile)%domain,gridtype=DGRID_NE,complete=.true. ) - call mpp_update_domains( atm(mytile)%pt, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%delp, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%q, Atm(mytile)%domain ) - - ! Cleanup - deallocate(phis_tmp) - -end subroutine read_inidat - -!======================================================================= - - subroutine calc_tot_energy_dynamics(atm,suffix) - use physconst, only: gravit, cpair, rearth, omega - use air_composition, only: thermodynamic_active_species_num,thermodynamic_active_species_idx_dycore - use air_composition, only: thermodynamic_active_species_cp,thermodynamic_active_species_cv,dry_air_species_num - use cam_history, only: outfld, hist_fld_active - use constituents, only: cnst_get_ind - use dimensions_mod, only: nlev - use fv_mp_mod, only: ng - !------------------------------Arguments-------------------------------- - - type(fv_atmos_type), pointer, intent(in) :: Atm(:) - character(len=*) , intent(in) :: suffix ! suffix for "outfld" names - - !---------------------------Local storage------------------------------- - - real(kind=r8), allocatable, dimension(:,:) :: se, &! Dry Static energy (J/m2) - ke, &! kinetic energy (J/m2) - ps_local ! ps temp based on CAM or FV3 airmass - real(kind=r8), allocatable, dimension(:,:) :: wv,wl,wi,wr,ws,wg ! col integ constiuents(kg/m2) - real(kind=r8), allocatable, dimension(:,:) :: tt ! column integrated test tracer (kg/m2) - real(kind=r8), allocatable, dimension(:,:,:) :: dp,delpograv - real(kind=r8) :: se_tmp, dpdry - real(kind=r8) :: ke_tmp - real(kind=r8) :: wv_tmp,wl_tmp,wi_tmp,wr_tmp,ws_tmp,wg_tmp - real(kind=r8) :: tt_tmp - - ! - ! global axial angular momentum (AAM) can be separated into one part (mr) - ! associated with the relative motion of the atmosphere with respect to the planet surface - ! (also known as wind AAM) and another part (mo) associated with the angular velocity OMEGA - ! (2*pi/d, where d is the length of the day) of the planet (also known as mass AAM) - ! - real(kind=r8), allocatable, dimension(:,:) :: mr ! wind AAM - real(kind=r8), allocatable, dimension(:,:) :: mo ! mass AAM - real(kind=r8) :: mr_cnst, mo_cnst, cos_lat, mr_tmp, mo_tmp - - real(kind=r8) :: se_glob, ke_glob, wv_glob, wl_glob, wi_glob, & - wr_glob, ws_glob, wg_glob, tt_glob, mr_glob, mo_glob - - integer :: i,j,k,nq,idim,m_cnst_ffsl - integer :: ixcldice, ixcldliq, ixtt,ixcldliq_ffsl,ixcldice_ffsl ! CLDICE, CLDLIQ and test tracer indices - integer :: ixrain, ixsnow, ixgraupel,ixrain_ffsl, ixsnow_ffsl, ixgraupel_ffsl - character(len=16) :: se_name,ke_name,wv_name,wl_name, & - wi_name,wr_name,ws_name,wg_name,tt_name,mo_name,mr_name - - integer :: is,ie,js,je,isd,ied,jsd,jed - logical :: printglobals = .false. - !----------------------------------------------------------------------- - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - isd = Atm(mytile)%bd%isd - ied = Atm(mytile)%bd%ied - jsd = Atm(mytile)%bd%jsd - jed = Atm(mytile)%bd%jed - - se_glob = 0._r8 - ke_glob = 0._r8 - wv_glob = 0._r8 - wl_glob = 0._r8 - wi_glob = 0._r8 - wr_glob = 0._r8 - ws_glob = 0._r8 - wg_glob = 0._r8 - tt_glob = 0._r8 - mr_glob = 0._r8 - mo_glob = 0._r8 - - allocate(se(is:ie,js:je)) - allocate(ke(is:ie,js:je)) - allocate(wv(is:ie,js:je)) - allocate(wl(is:ie,js:je)) - allocate(wi(is:ie,js:je)) - allocate(wr(is:ie,js:je)) - allocate(ws(is:ie,js:je)) - allocate(wg(is:ie,js:je)) - allocate(tt(is:ie,js:je)) - allocate(mr(is:ie,js:je)) - allocate(mo(is:ie,js:je)) - allocate(dp(is:ie,js:je,nlev)) - allocate(delpograv(is:ie,js:je,nlev)) - allocate(ps_local(is:ie,js:je)) - - se_name = 'SE_' //trim(suffix) - ke_name = 'KE_' //trim(suffix) - wv_name = 'WV_' //trim(suffix) - wl_name = 'WL_' //trim(suffix) - wi_name = 'WI_' //trim(suffix) - wr_name = 'WR_' //trim(suffix) - ws_name = 'WS_' //trim(suffix) - wg_name = 'WG_' //trim(suffix) - tt_name = 'TT_' //trim(suffix) - - - if ( hist_fld_active(se_name).or.hist_fld_active(ke_name).or. & - hist_fld_active(wv_name).or.hist_fld_active(wl_name).or. & - hist_fld_active(wi_name).or.hist_fld_active(wr_name).or. & - hist_fld_active(ws_name).or.hist_fld_active(wg_name).or. & - hist_fld_active(tt_name)) then - if (thermodynamic_active_species_num-dry_air_species_num > 1) then - call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) - call cnst_get_ind('CLDICE', ixcldice, abort=.false.) - call cnst_get_ind('RAINQM', ixrain, abort=.false.) - call cnst_get_ind('SNOWQM', ixsnow, abort=.false.) - call cnst_get_ind('GRAUQM', ixgraupel, abort=.false.) - else - ixcldliq = -1 - ixcldice = -1 - ixrain = -1 - ixsnow = -1 - ixgraupel = -1 - end if - - call cnst_get_ind('TT_LW', ixtt, abort=.false.) - - ! - ! Compute frozen static energy in 3 parts: KE, SE, and energy associated with vapor and liquid - ! - - se = 0.0_r8 - ke = 0.0_r8 - wv = 0.0_r8 - wl = 0.0_r8 - wi = 0.0_r8 - wr = 0.0_r8 - ws = 0.0_r8 - wg = 0.0_r8 - tt = 0.0_r8 - - delpograv(is:ie,js:je,1:nlev) = Atm(mytile)%delp(is:ie,js:je,1:nlev)/gravit ! temporary - - ! - ! Calculate Energy, CAM or FV3 based on fv3_lcp_moist and fv3_lcv_moist - ! - - - do k = 1, nlev - do j=js,je - do i = is, ie - ! initialize dp with delp - dp(i,j,k) = Atm(mytile)%delp(i,j,k) - ! - ! if neither fv3_lcp_moist and fv3_lcv_moist is set then - ! use cam definition of internal energy - ! adjust dp to be consistent with CAM physics air mass (only water vapor and dry air in pressure) - if ((.not.fv3_lcp_moist).and.(.not.fv3_lcv_moist)) then - if (thermodynamic_active_species_num-dry_air_species_num > 1) then - ! adjust dp to include just dry + vap to use below - do nq=2,thermodynamic_active_species_num-dry_air_species_num - m_cnst_ffsl=thermodynamic_active_species_idx_dycore(nq) - dp(i,j,k) = dp(i,j,k) - & - Atm(mytile)%delp(i,j,k)*Atm(mytile)%q(i,j,k,m_cnst_ffsl) - end do - end if - se_tmp = cpair*Atm(mytile)%pt(i,j,k)*dp(i,j,k)/gravit - else - ! if either fv3_lcp_moist or fv3_lcv_moist is set then - ! use all condensates in calculation of energy and dp - ! Start with energy of dry air and add energy of condensates - dpdry = Atm(mytile)%delp(i,j,k) - do nq=1,thermodynamic_active_species_num-dry_air_species_num - m_cnst_ffsl=thermodynamic_active_species_idx_dycore(nq) - dpdry = dpdry - Atm(mytile)%delp(i,j,k)*Atm(mytile)%q(i,j,k,nq) - end do - se_tmp = cpair*dpdry - do nq=1,thermodynamic_active_species_num-dry_air_species_num - m_cnst_ffsl=thermodynamic_active_species_idx_dycore(nq) - if (fv3_lcp_moist) then - se_tmp = se_tmp + & - thermodynamic_active_species_cp(nq)*Atm(mytile)%q(i,j,k,m_cnst_ffsl) * & - Atm(mytile)%delp(i,j,k) - end if - if (fv3_lcv_moist) then - se_tmp = se_tmp + & - thermodynamic_active_species_cv(nq)*Atm(mytile)%q(i,j,k,m_cnst_ffsl) * & - Atm(mytile)%delp(i,j,k) - end if - end do - se_tmp = se_tmp*Atm(mytile)%pt(i,j,k)/gravit - end if - ke_tmp = 0.5_r8*(Atm(mytile)%va(i,j,k)**2+ Atm(mytile)%ua(i,j,k)**2)*dp(i,j,k)/gravit - wv_tmp = Atm(mytile)%q(i,j,k,1)*delpograv(i,j,k) - - se(i,j) = se(i,j) + se_tmp - ke(i,j) = ke(i,j) + ke_tmp - wv(i,j) = wv(i,j) + wv_tmp - end do - end do - end do - - do j=js,je - do i = is,ie - ps_local(i,j) = Atm(mytile)%ptop+sum(dp(i,j,:)) - end do - end do - - do j=js,je - do i = is,ie - se(i,j) = se(i,j) + Atm(mytile)%phis(i,j)*ps_local(i,j)/gravit - end do - end do - - ! Don't require cloud liq/ice to be present. Allows for adiabatic/ideal phys. - - if (ixcldliq > 1) then - ixcldliq_ffsl = qsize_tracer_idx_cam2dyn(ixcldliq) - do k = 1, nlev - do j = js, je - do i = is, ie - wl_tmp = Atm(mytile)%q(i,j,k,ixcldliq_ffsl)*delpograv(i,j,k) - wl (i,j) = wl(i,j) + wl_tmp - end do - end do - end do - end if - - if (ixcldice > 1) then - ixcldice_ffsl = qsize_tracer_idx_cam2dyn(ixcldice) - do k = 1, nlev - do j = js, je - do i = is, ie - wi_tmp = Atm(mytile)%q(i,j,k,ixcldice_ffsl)*delpograv(i,j,k) - wi(i,j) = wi(i,j) + wi_tmp - end do - end do - end do - end if - - if (ixrain > 1) then - ixrain_ffsl = qsize_tracer_idx_cam2dyn(ixrain) - do k = 1, nlev - do j = js, je - do i = is, ie - wr_tmp = Atm(mytile)%q(i,j,k,ixrain_ffsl)*delpograv(i,j,k) - wr (i,j) = wr(i,j) + wr_tmp - end do - end do - end do - end if - - if (ixsnow > 1) then - ixsnow_ffsl = qsize_tracer_idx_cam2dyn(ixsnow) - do k = 1, nlev - do j = js, je - do i = is, ie - ws_tmp = Atm(mytile)%q(i,j,k,ixsnow_ffsl)*delpograv(i,j,k) - ws(i,j) = ws(i,j) + ws_tmp - end do - end do - end do - end if - - if (ixgraupel > 1) then - ixgraupel_ffsl = qsize_tracer_idx_cam2dyn(ixgraupel) - do k = 1, nlev - do j = js, je - do i = is, ie - wg_tmp = Atm(mytile)%q(i,j,k,ixgraupel_ffsl)*delpograv(i,j,k) - wg(i,j) = wg(i,j) + wg_tmp - end do - end do - end do - end if - - - if (ixtt > 1) then - do k = 1, nlev - do j = js, je - do i = is, ie - tt_tmp = Atm(mytile)%q(i,j,k,ixtt)*delpograv(i,j,k) - tt (i,j) = tt(i,j) + tt_tmp - end do - end do - end do - end if - idim=ie-is+1 - do j=js,je - ! Output energy diagnostics - call outfld(se_name ,se(:,j) ,idim, j) - call outfld(ke_name ,ke(:,j) ,idim, j) - call outfld(wv_name ,wv(:,j) ,idim, j) - call outfld(wl_name ,wl(:,j) ,idim, j) - call outfld(wi_name ,wi(:,j) ,idim, j) - call outfld(wr_name ,wr(:,j) ,idim, j) - call outfld(ws_name ,ws(:,j) ,idim, j) - call outfld(wg_name ,wg(:,j) ,idim, j) - if (ixtt > 1) call outfld(tt_name ,tt(:,j) ,idim, j) - end do - - if (printglobals) then - se_glob=g_sum(Atm(mytile)%domain, se(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - ke_glob=g_sum(Atm(mytile)%domain, ke(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - wv_glob=g_sum(Atm(mytile)%domain, wv(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - wl_glob=g_sum(Atm(mytile)%domain, wl(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - wi_glob=g_sum(Atm(mytile)%domain, wi(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - wr_glob=g_sum(Atm(mytile)%domain, wr(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - ws_glob=g_sum(Atm(mytile)%domain, ws(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - wg_glob=g_sum(Atm(mytile)%domain, wg(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - if (ixtt > 1) & - tt_glob=g_sum(Atm(mytile)%domain, tt(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - if (masterproc) then - - write(iulog, '(a,e25.17)') 'static energy se_'//trim(suffix)//') = ',se_glob - write(iulog, '(a,e25.17)') 'kinetic energy ke_'//trim(suffix)//') = ',ke_glob - write(iulog, '(a,e25.17)') 'total energy se_plus_ke_'//trim(suffix)//') = ',(ke_glob+se_glob) - write(iulog, '(a,e25.17)') 'integrated vapor wv_'//trim(suffix)//' = ',wv_glob - write(iulog, '(a,e25.17)') 'integrated liquid wl_'//trim(suffix)//' = ',wl_glob - write(iulog, '(a,e25.17)') 'integrated ice wi_'//trim(suffix)//' = ',wi_glob - write(iulog, '(a,e25.17)') 'integrated liquid rain wr_'//trim(suffix)//' = ',wr_glob - write(iulog, '(a,e25.17)') 'integrated liquid snow ws_'//trim(suffix)//' = ',ws_glob - write(iulog, '(a,e25.17)') 'integrated graupel wg_'//trim(suffix)//' = ',wg_glob - if (ixtt > 1) write(iulog, '(a,e25.17)') & - 'global column integrated test tracer tt_'//trim(suffix)//' = ',tt_glob - end if - end if - end if - - ! - ! Axial angular momentum diagnostics - ! - ! Code follows - ! - ! Lauritzen et al., (2014): Held-Suarez simulations with the Community Atmosphere Model - ! Spectral Element (CAM-SE) dynamical core: A global axial angularmomentum analysis using Eulerian - ! and floating Lagrangian vertical coordinates. J. Adv. Model. Earth Syst. 6,129-140, - ! doi:10.1002/2013MS000268 - ! - ! MR is equation (6) without \Delta A and sum over areas (areas are in units of radians**2) - ! MO is equation (7) without \Delta A and sum over areas (areas are in units of radians**2) - ! - mr_name = 'MR_' //trim(suffix) - mo_name = 'MO_' //trim(suffix) - - if ( hist_fld_active(mr_name).or.hist_fld_active(mo_name)) then - - - - mr_cnst = rearth**3/gravit - mo_cnst = omega*rearth**4/gravit - mr = 0.0_r8 - mo = 0.0_r8 - do k = 1, nlev - do j=js,je - do i = is,ie - cos_lat = cos(Atm(mytile)%gridstruct%agrid_64(i,j,2)) - mr_tmp = mr_cnst*Atm(mytile)%ua(i,j,k)*Atm(mytile)%delp(i,j,k)*cos_lat - mo_tmp = mo_cnst*Atm(mytile)%delp(i,j,k)*cos_lat**2 - - mr (i,j) = mr(i,j) + mr_tmp - mo (i,j) = mo(i,j) + mo_tmp - end do - end do - end do - do j=js,je - call outfld(mr_name ,mr(is:ie,j) ,idim,j) - call outfld(mo_name ,mo(is:ie,j) ,idim,j) - end do - - if (printglobals) then - mr_glob=g_sum(Atm(mytile)%domain, mr(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - mo_glob=g_sum(Atm(mytile)%domain, mo(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - if (masterproc) then - write(iulog, '(a,e25.17)') 'integrated wind AAM '//trim(mr_name)//' = ',mr_glob - write(iulog, '(a,e25.17)') 'integrated mass AAM '//trim(mo_name)//' = ',mo_glob - end if - end if - end if - - deallocate(ps_local) - deallocate(dp) - deallocate(delpograv) - deallocate(se) - deallocate(ke) - deallocate(wv) - deallocate(wl) - deallocate(wi) - deallocate(wr) - deallocate(ws) - deallocate(wg) - deallocate(tt) - deallocate(mr) - deallocate(mo) - end subroutine calc_tot_energy_dynamics - -!======================================================================================== - -logical function dyn_field_exists(fh, fieldname, required) - - use pio, only: file_desc_t, var_desc_t, PIO_inq_varid - use pio, only: PIO_NOERR - - ! Arguments - type(file_desc_t), intent(in) :: fh - character(len=*), intent(in) :: fieldname - logical, optional, intent(in) :: required - - ! Local variables - logical :: found - logical :: field_required - integer :: ret - type(var_desc_t) :: varid - character(len=128) :: errormsg - !-------------------------------------------------------------------------- - - if (present(required)) then - field_required = required - else - field_required = .true. - end if - - ret = PIO_inq_varid(fh, trim(fieldname), varid) - found = (ret == PIO_NOERR) - if (.not. found) then - if (field_required) then - write(errormsg, *) trim(fieldname),' was not present in the input file.' - call endrun('DYN_FIELD_EXISTS: '//errormsg) - end if - end if - - dyn_field_exists = found - -end function dyn_field_exists - -!======================================================================================== - - subroutine read_dyn_field_2d(fieldname, fh, dimname, buffer) - use pio, only: file_desc_t - use ncdio_atm, only: infld - - ! Dummy arguments - character(len=*), intent(in) :: fieldname - type(file_desc_t), intent(inout) :: fh - character(len=*), intent(in) :: dimname - real(r8), intent(inout) :: buffer(:, :) - - ! Local variables - logical :: found - !-------------------------------------------------------------------------- - - buffer = 0.0_r8 - call infld(trim(fieldname), fh, dimname, 1, ldof_size, 1, 1, buffer, & - found, gridname=ini_grid_name) - if(.not. found) then - call endrun('READ_DYN_FIELD_2D: Could not find '//trim(fieldname)//' field on input datafile') - end if - - ! This code allows use of compiler option to set uninitialized values - ! to NaN. In that case infld can return NaNs where the element ini_grid_name points - ! are not "unique columns" - where (isnan(buffer)) buffer = 0.0_r8 - - end subroutine read_dyn_field_2d - -!======================================================================================== - - subroutine read_dyn_field_3d(fieldname, fh, dimname, buffer) - use pio, only: file_desc_t - use ncdio_atm, only: infld - - ! Dummy arguments - character(len=*), intent(in) :: fieldname - type(file_desc_t), intent(inout) :: fh - character(len=*), intent(in) :: dimname - real(r8), intent(inout) :: buffer(:,:,:) - - ! Local variables - logical :: found - !-------------------------------------------------------------------------- - - buffer = 0.0_r8 - call infld(fieldname, fh,dimname, 'lev', 1, ldof_size, 1, pver, & - 1, 1, buffer, found, gridname=ini_grid_name) - if(.not. found) then - call endrun('READ_DYN_FIELD_3D: Could not find '//trim(fieldname)//' field on input datafile') - end if - - ! This code allows use of compiler option to set uninitialized values - ! to NaN. In that case infld can return NaNs where the element ini_grid_name points - ! are not "unique columns" - where (isnan(buffer)) buffer = 0.0_r8 - - end subroutine read_dyn_field_3d - -!========================================================================================= - -subroutine write_dyn_var(field,outfld_name,bd) - - use cam_history, only: outfld - - ! Arguments - type(fv_grid_bounds_type), intent(in) :: bd - real(r8), intent(in) :: field(bd%is:bd%ie,bd%js:bd%je) - character(len=*) , intent(in) :: outfld_name ! suffix for "outfld" names - - ! local variables - integer :: idim, j - - !---------------------------------------------------------------------------- - idim=bd%ie-bd%is+1 - do j=bd%js,bd%je - ! Output energy diagnostics - call outfld(trim(outfld_name) ,field(bd%is:bd%ie,j) ,idim, j) - end do - -end subroutine write_dyn_var - -!========================================================================================= - -subroutine set_dry_mass(atm,fixed_global_ave_dry_ps) - - !---------------------------------------------------------------------------- - - use constituents, only: pcnst, qmin - use cam_logfile, only: iulog - use hycoef, only: hyai, hybi, ps0 - use dimensions_mod, only: nlev - use dyn_grid, only: mytile - use air_composition, only: thermodynamic_active_species_num,thermodynamic_active_species_idx_dycore,dry_air_species_num - - ! Arguments - type (fv_atmos_type), intent(in), pointer :: Atm(:) - real (kind=r8), intent(in) :: fixed_global_ave_dry_ps - - ! local - real (kind=r8) :: global_ave_ps_inic,global_ave_dryps_inic,global_ave_dryps_scaled, & - global_ave_ps_new,global_ave_dryps_new - real (r8), allocatable, dimension(:,:) :: psdry, psdry_scaled, psdry_new - real (r8), allocatable, dimension(:,:,:) :: factor, delpwet, delpdry, newdelp - integer :: i, j ,k, m,is,ie,js,je - integer :: num_wet_species ! first tracers in FV3 tracer array - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - allocate(factor(is:ie,js:je,nlev)) - allocate(delpdry(is:ie,js:je,nlev)) - allocate(delpwet(is:ie,js:je,nlev)) - allocate(newdelp(is:ie,js:je,nlev)) - allocate(psdry(is:ie,js:je)) - allocate(psdry_scaled(is:ie,js:je)) - allocate(psdry_new(is:ie,js:je)) - - - if (fixed_global_ave_dry_ps == 0) return; - - ! get_global_ave_surface_pressure - must use bitwise sum (reproducable) - global_ave_ps_inic=g_sum(Atm(mytile)%domain, Atm(mytile)%ps(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - - num_wet_species=thermodynamic_active_species_num-dry_air_species_num - do k=1,pver - do j = js, je - do i = is, ie - delpdry(i,j,k)=Atm(mytile)%delp(i,j,k) * (1.0_r8 - & - sum(Atm(mytile)%q(i,j,k,thermodynamic_active_species_idx_dycore(1:num_wet_species)))) - delpwet(i,j,k)=Atm(mytile)%delp(i,j,k)-delpdry(i,j,k) - end do - end do - end do - ! - ! get psdry and scale it - ! - do j = js, je - do i = is, ie - psdry(i,j) = hyai(1)*ps0 + sum(delpdry(i,j,:)) - end do - end do - - global_ave_dryps_inic=g_sum(Atm(mytile)%domain, psdry(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - - psdry_scaled = psdry*(fixed_global_ave_dry_ps/global_ave_dryps_inic) - - global_ave_dryps_scaled=g_sum(Atm(mytile)%domain, psdry_scaled(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - - !use adjusted psdry to calculate new dp_dry throughout atmosphere - do k=1,pver - do j = js, je - do i = is, ie - delpdry(i,j,k)=(hyai(k+1)-hyai(k))*ps0+& - (hybi(k+1)-hybi(k))*psdry_scaled(i,j) - ! new dp is adjusted dp + total watermass - newdelp(i,j,k)=(delpdry(i,j,k)+delpwet(i,j,k)) - ! factor to conserve mass once using the new dp - factor(i,j,k)=Atm(mytile)%delp(i,j,k)/newdelp(i,j,k) - Atm(mytile)%delp(i,j,k)=newdelp(i,j,k) - end do - end do - end do - ! - ! all tracers wet in fv3 so conserve initial condition mass of 'wet' tracers (following se prim_set_dry) - ! - do m=1,pcnst - do k=1,pver - do j = js, je - do i = is, ie - Atm(mytile)%q(i,j,k,m)=Atm(mytile)%q(i,j,k,m)*factor(i,j,k) - Atm(mytile)%q(i,j,k,m)=max(qmin(m),Atm(mytile)%q(i,j,k,m)) - end do - end do - end do - end do - - do j = js, je - do i = is, ie - Atm(mytile)%ps(i,j)=hyai(1)*ps0+sum(Atm(mytile)%delp(i, j, :)) - psdry_new(i,j)=hyai(1)*ps0+sum(delpdry(i, j, :)) - end do - end do - global_ave_ps_new= g_sum(Atm(mytile)%domain, Atm(mytile)%ps(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - global_ave_dryps_new=g_sum(Atm(mytile)%domain, psdry_new(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - - if (masterproc) then - write (iulog,*) "-------------------------- set_dry_mass---------------------------------------------" - write (iulog,*) "Scaling dry surface pressure to global average of = ",& - fixed_global_ave_dry_ps/100.0_r8,"hPa" - write (iulog,*) "Average surface pressure in initial condition = ", & - global_ave_ps_inic/100.0_r8,"hPa" - write (iulog,*) "Average dry surface pressure in initial condition = ",& - global_ave_dryps_inic/100.0_r8,"hPa" - write (iulog,*) "Average surface pressure after scaling = ",global_ave_ps_new/100.0_r8,"hPa" - write (iulog,*) "Average dry surface pressure after scaling = ",global_ave_dryps_new/100.0_r8,"hPa" - write (iulog,*) "Change in surface pressure = ",& - global_ave_ps_new-global_ave_ps_inic,"Pa" - write (iulog,*) "Change in dry surface pressure = ",& - global_ave_dryps_new-global_ave_dryps_inic,"Pa" - write (iulog,*) "Mixing ratios have been scaled so that total mass of tracer is conserved" - write (iulog,*) "Total precipitable water before scaling = ", & - (global_ave_ps_inic-global_ave_dryps_inic)/gravit, '(kg/m**2)' - write (iulog,*) "Total precipitable water after scaling = ", & - (global_ave_ps_new-global_ave_dryps_new)/gravit, '(kg/m**2)' - endif - - deallocate(factor) - deallocate(delpdry) - deallocate(delpwet) - deallocate(newdelp) - deallocate(psdry) - deallocate(psdry_scaled) - deallocate(psdry_new) - -end subroutine set_dry_mass -!========================================================================================= - -subroutine a2d3djt(ua, va, u, v, is, ie, js, je, isd, ied, jsd, jed, npx,npy, nlev, gridstruct, domain) - -! This routine interpolates cell centered a-grid winds to d-grid (cell edges) - - use mpp_domains_mod, only: mpp_update_domains, DGRID_NE - use fv_arrays_mod, only: fv_grid_type - - ! arguments - integer, intent(in) :: is, ie, js, je - integer, intent(in) :: isd, ied, jsd, jed - integer, intent(in) :: npx,npy, nlev - real(r8), intent(inout), dimension(isd:ied, jsd:jed+1,nlev) :: u - real(r8), intent(inout), dimension(isd:ied+1,jsd:jed ,nlev) :: v - real(r8), intent(inout), dimension(isd:ied,jsd:jed,nlev) :: ua, va - type(fv_grid_type), intent(in), target :: gridstruct - type(domain2d), intent(inout) :: domain - - ! local: - real(r8), dimension(is-1:ie+1,js-1:je+1,3) :: v3 - real(r8), dimension(is-1:ie+1,js:je+1,3) :: ue ! 3D winds at edges - real(r8), dimension(is:ie+1,js-1:je+1, 3) :: ve ! 3D winds at edges - real(r8), dimension(is:ie) :: ut1, ut2, ut3 - real(r8), dimension(js:je) :: vt1, vt2, vt3 - integer :: i, j, k, im2, jm2 - - real(r8), pointer, dimension(:,:,:) :: vlon, vlat - real(r8), pointer, dimension(:,:,:,:) :: es, ew - real(r8), pointer, dimension(:) :: edge_vect_w, edge_vect_e, edge_vect_s, edge_vect_n - - es => gridstruct%es - ew => gridstruct%ew - vlon => gridstruct%vlon - vlat => gridstruct%vlat - - edge_vect_w => gridstruct%edge_vect_w - edge_vect_e => gridstruct%edge_vect_e - edge_vect_s => gridstruct%edge_vect_s - edge_vect_n => gridstruct%edge_vect_n - - call mpp_update_domains(ua, domain, complete=.false.) - call mpp_update_domains(va, domain, complete=.true.) - - im2 = (npx-1)/2 - jm2 = (npy-1)/2 - -!$OMP parallel do default(none) shared(is,ie,js,je,nlev,gridstruct,u,ua,v,va, & -!$OMP vlon,vlat,jm2,edge_vect_w,npx,edge_vect_e,im2, & -!$OMP edge_vect_s,npy,edge_vect_n,es,ew) & -!$OMP private(i,j,k,ut1, ut2, ut3, vt1, vt2, vt3, ue, ve, v3) - do k=1, nlev - - ! Compute 3D wind/tendency on A grid - do j=js-1,je+1 - do i=is-1,ie+1 - v3(i,j,1) = ua(i,j,k)*vlon(i,j,1) + va(i,j,k)*vlat(i,j,1) - v3(i,j,2) = ua(i,j,k)*vlon(i,j,2) + va(i,j,k)*vlat(i,j,2) - v3(i,j,3) = ua(i,j,k)*vlon(i,j,3) + va(i,j,k)*vlat(i,j,3) - enddo - enddo - - ! Interpolate to cell edges - do j=js,je+1 - do i=is-1,ie+1 - ue(i,j,1) = 0.5_r8*(v3(i,j-1,1) + v3(i,j,1)) - ue(i,j,2) = 0.5_r8*(v3(i,j-1,2) + v3(i,j,2)) - ue(i,j,3) = 0.5_r8*(v3(i,j-1,3) + v3(i,j,3)) - enddo - enddo - - do j=js-1,je+1 - do i=is,ie+1 - ve(i,j,1) = 0.5_r8*(v3(i-1,j,1) + v3(i,j,1)) - ve(i,j,2) = 0.5_r8*(v3(i-1,j,2) + v3(i,j,2)) - ve(i,j,3) = 0.5_r8*(v3(i-1,j,3) + v3(i,j,3)) - enddo - enddo - - ! --- E_W edges (for v-wind): - if (.not. gridstruct%nested) then - if ( is==1) then - i = 1 - do j=js,je - if ( j>jm2 ) then - vt1(j) = edge_vect_w(j)*ve(i,j-1,1)+(1._r8-edge_vect_w(j))*ve(i,j,1) - vt2(j) = edge_vect_w(j)*ve(i,j-1,2)+(1._r8-edge_vect_w(j))*ve(i,j,2) - vt3(j) = edge_vect_w(j)*ve(i,j-1,3)+(1._r8-edge_vect_w(j))*ve(i,j,3) - else - vt1(j) = edge_vect_w(j)*ve(i,j+1,1)+(1._r8-edge_vect_w(j))*ve(i,j,1) - vt2(j) = edge_vect_w(j)*ve(i,j+1,2)+(1._r8-edge_vect_w(j))*ve(i,j,2) - vt3(j) = edge_vect_w(j)*ve(i,j+1,3)+(1._r8-edge_vect_w(j))*ve(i,j,3) - endif - enddo - do j=js,je - ve(i,j,1) = vt1(j) - ve(i,j,2) = vt2(j) - ve(i,j,3) = vt3(j) - enddo - endif - - if ( (ie+1)==npx ) then - i = npx - do j=js,je - if ( j>jm2 ) then - vt1(j) = edge_vect_e(j)*ve(i,j-1,1)+(1._r8-edge_vect_e(j))*ve(i,j,1) - vt2(j) = edge_vect_e(j)*ve(i,j-1,2)+(1._r8-edge_vect_e(j))*ve(i,j,2) - vt3(j) = edge_vect_e(j)*ve(i,j-1,3)+(1._r8-edge_vect_e(j))*ve(i,j,3) - else - vt1(j) = edge_vect_e(j)*ve(i,j+1,1)+(1._r8-edge_vect_e(j))*ve(i,j,1) - vt2(j) = edge_vect_e(j)*ve(i,j+1,2)+(1._r8-edge_vect_e(j))*ve(i,j,2) - vt3(j) = edge_vect_e(j)*ve(i,j+1,3)+(1._r8-edge_vect_e(j))*ve(i,j,3) - endif - enddo - do j=js,je - ve(i,j,1) = vt1(j) - ve(i,j,2) = vt2(j) - ve(i,j,3) = vt3(j) - enddo - endif - ! N-S edges (for u-wind): - if ( js==1) then - j = 1 - do i=is,ie - if ( i>im2 ) then - ut1(i) = edge_vect_s(i)*ue(i-1,j,1)+(1._r8-edge_vect_s(i))*ue(i,j,1) - ut2(i) = edge_vect_s(i)*ue(i-1,j,2)+(1._r8-edge_vect_s(i))*ue(i,j,2) - ut3(i) = edge_vect_s(i)*ue(i-1,j,3)+(1._r8-edge_vect_s(i))*ue(i,j,3) - else - ut1(i) = edge_vect_s(i)*ue(i+1,j,1)+(1._r8-edge_vect_s(i))*ue(i,j,1) - ut2(i) = edge_vect_s(i)*ue(i+1,j,2)+(1._r8-edge_vect_s(i))*ue(i,j,2) - ut3(i) = edge_vect_s(i)*ue(i+1,j,3)+(1._r8-edge_vect_s(i))*ue(i,j,3) - endif - enddo - do i=is,ie - ue(i,j,1) = ut1(i) - ue(i,j,2) = ut2(i) - ue(i,j,3) = ut3(i) - enddo - endif - if ( (je+1)==npy ) then - j = npy - do i=is,ie - if ( i>im2 ) then - ut1(i) = edge_vect_n(i)*ue(i-1,j,1)+(1._r8-edge_vect_n(i))*ue(i,j,1) - ut2(i) = edge_vect_n(i)*ue(i-1,j,2)+(1._r8-edge_vect_n(i))*ue(i,j,2) - ut3(i) = edge_vect_n(i)*ue(i-1,j,3)+(1._r8-edge_vect_n(i))*ue(i,j,3) - else - ut1(i) = edge_vect_n(i)*ue(i+1,j,1)+(1._r8-edge_vect_n(i))*ue(i,j,1) - ut2(i) = edge_vect_n(i)*ue(i+1,j,2)+(1._r8-edge_vect_n(i))*ue(i,j,2) - ut3(i) = edge_vect_n(i)*ue(i+1,j,3)+(1._r8-edge_vect_n(i))*ue(i,j,3) - endif - enddo - do i=is,ie - ue(i,j,1) = ut1(i) - ue(i,j,2) = ut2(i) - ue(i,j,3) = ut3(i) - enddo - endif - - endif ! .not. nested - - do j=js,je+1 - do i=is,ie - u(i,j,k) = ue(i,j,1)*es(1,i,j,1) + & - ue(i,j,2)*es(2,i,j,1) + & - ue(i,j,3)*es(3,i,j,1) - enddo - enddo - do j=js,je - do i=is,ie+1 - v(i,j,k) = ve(i,j,1)*ew(1,i,j,2) + & - ve(i,j,2)*ew(2,i,j,2) + & - ve(i,j,3)*ew(3,i,j,2) - enddo - enddo - enddo ! k-loop - - call mpp_update_domains(u, v, domain, gridtype=DGRID_NE) - -end subroutine a2d3djt - -end module dyn_comp diff --git a/src/dynamics/fv3/dyn_grid.F90 b/src/dynamics/fv3/dyn_grid.F90 deleted file mode 100644 index 263c04ac3b..0000000000 --- a/src/dynamics/fv3/dyn_grid.F90 +++ /dev/null @@ -1,1108 +0,0 @@ -module dyn_grid -!------------------------------------------------------------------------------- -! Define FV3 computational grids on the dynamics decomposition. -! -! The grid used by the FV3 dynamics is called the FSSL grid and is a -! gnomonic cubed sphere consisting of 6 tiled faces. Each tile consists -! of an array of cells whose coordinates are great circles. The grid -! nomenclature (C96, C384, etc.) describes the number of cells along -! the top and side of a tile face (square). All prognostic variables -! are 3-D cell-mean values (cell center), except for the horizontal winds, -! which are 2-D face-mean values located on the cell walls (D-Grid winds). -! Each tile can be decomposed into a number of subdomains (consisting of -! one or more cells) which correspond to "blocks" in the physics/dynamics -! coupler terminology. The namelist variable "layout" consists of 2 integers -! and determines the size/shape of the blocks by dividing the tile into a -! number of horizonal and vertical sections. The total number of blocks in -! the global domain is therefore layout(1)*layout(2)*ntiles. The decomposition -! and communication infrastructure is provided by the GFDL FMS library. -! -! Module responsibilities: -! -! . Provide the physics/dynamics coupler (in module phys_grid) with data for the -! physics grid on the dynamics decomposition. -! -! . Create CAM grid objects that are used by the I/O functionality to read -! data from an unstructured grid format to the dynamics data structures, and -! to write from the dynamics data structures to unstructured grid format. The -! global column ordering for the unstructured grid is determined by the FV3 dycore. -! -!------------------------------------------------------------------------------- - - use cam_abortutils, only: endrun - use cam_grid_support, only: iMap - use cam_logfile, only: iulog - use dimensions_mod, only: npx, npy, ntiles - use fms_mod, only: fms_init, write_version_number - use fv_arrays_mod, only: fv_atmos_type - use fv_control_mod, only: ngrids,fv_init - use fv_mp_mod, only: mp_bcst - use mpp_mod, only: mpp_pe, mpp_root_pe - use physconst, only: rearth,pi - use shr_kind_mod, only: r8 => shr_kind_r8 - use spmd_utils, only: mpicom, masterproc - - implicit none - private - save - - ! The FV3 dynamics grids and initial file ncol grid - integer, parameter :: dyn_decomp = 101 - integer, parameter :: dyn_decomp_ew = 102 - integer, parameter :: dyn_decomp_ns = 103 - integer, parameter :: dyn_decomp_hist = 104 - integer, parameter :: dyn_decomp_hist_ew = 105 - integer, parameter :: dyn_decomp_hist_ns = 106 - integer, parameter :: ini_decomp = 107 - - character(len=3), protected :: ini_grid_name = 'INI' - - integer, parameter :: ptimelevels = 2 ! number of time levels in the dycore - - integer :: mytile = 1 - integer :: p_split = 1 - integer, allocatable :: pelist(:) - - real(r8), parameter :: rad2deg = 180._r8/pi - - logical, allocatable :: grids_on_this_pe(:) - type(fv_atmos_type), allocatable, target :: Atm(:) - - -public :: & - dyn_decomp, & - ini_grid_name, & - p_split, & - grids_on_this_pe, & - ptimelevels - -!----------------------------------------------------------------------- -! Calculate Global Index - -integer, allocatable, target, dimension(:,:) :: mygindex -integer, allocatable, target, dimension(:,:) :: mylindex -integer, allocatable, target, dimension(:,:) :: myblkidx -real(r8), allocatable, target, dimension(:,:,:) :: locidx_g -real(r8), allocatable, target, dimension(:,:,:) :: blkidx_g -real(r8), allocatable, target, dimension(:,:,:) :: gindex_g - -real(r8), allocatable :: block_extents_g(:,:) - -integer :: uniqpts_glob = 0 ! number of dynamics columns -integer :: uniqpts_glob_ew = 0 ! number of dynamics columns for D grid ew -integer :: uniqpts_glob_ns = 0 ! number of dynamics columns for D grid ns - -real(r8), pointer, dimension(:,:,:) :: grid_ew, grid_ns - -public :: mygindex -public :: mylindex -!----------------------------------------------------------------------- -public :: & - dyn_grid_init, & - get_block_bounds_d, & ! get first and last indices in global block ordering - get_block_gcol_d, & ! get column indices for given block - get_block_gcol_cnt_d, & ! get number of columns in given block - get_block_lvl_cnt_d, & ! get number of vertical levels in column - get_block_levels_d, & ! get vertical levels in column - get_block_owner_d, & ! get process "owning" given block - get_gcol_block_d, & ! get global block indices and local columns - ! index for given global column index - get_gcol_block_cnt_d, & ! get number of blocks containing data - ! from a given global column index - get_horiz_grid_dim_d, & - get_horiz_grid_d, & ! get horizontal grid coordinates - get_dyn_grid_parm, & - get_dyn_grid_parm_real1d, & - dyn_grid_get_elem_coords, & ! get coordinates of a specified block element - dyn_grid_get_colndx, & ! get element block/column and MPI process indices - ! corresponding to a specified global column index - physgrid_copy_attributes_d - -public Atm, mytile - -!======================================================================= -contains -!======================================================================= - -subroutine dyn_grid_init() - - ! Initialize FV grid, decomposition - - use block_control_mod, only: block_control_type, define_blocks_packed - use cam_initfiles, only: initial_file_get_id - use constants_mod, only: constants_init - use fv_mp_mod, only: switch_current_Atm,mp_gather, mp_bcst - use hycoef, only: hycoef_init, hyai, hybi, hypi, hypm, nprlev - use mpp_mod, only: mpp_init, mpp_npes, mpp_get_current_pelist,mpp_gather - use pmgrid, only: plev - use ref_pres, only: ref_pres_init - use time_manager, only: get_step_size - use pio, only: file_desc_t - - ! Local variables - - type(file_desc_t), pointer :: fh_ini - - character(len=*), parameter :: sub='dyn_grid_init' - character(len=128) :: version = '$Id$' - character(len=128) :: tagname = '$Name$' - - real(r8) :: dt_atmos_real = 0._r8 - - integer :: i, j, k, tile - integer :: is,ie,js,je,n,nx,ny - character(len=128) :: errmsg - - !----------------------------------------------------------------------- - ! from couple_main initialize atm structure - initializes fv3 grid - !----------------------------------------------------------------------- - - call fms_init(mpicom) - call mpp_init() - call constants_init - -!----------------------------------------------------------------------- -! initialize atmospheric model ----- - - allocate(pelist(mpp_npes())) - call mpp_get_current_pelist(pelist) - -!---- compute physics/atmos time step in seconds ---- - - dt_atmos_real = get_step_size() - -!----- initialize FV dynamical core ----- - - call fv_init( Atm, dt_atmos_real, grids_on_this_pe, p_split) ! allocates Atm components - - do n=1,ngrids - if (grids_on_this_pe(n)) mytile = n - enddo - -!----- write version and namelist to log file ----- - call write_version_number ( version, tagname ) - - call switch_current_Atm(Atm(mytile)) - -!! set up dimensions_mod convenience variables. - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - npx = Atm(mytile)%flagstruct%npx - npy = Atm(mytile)%flagstruct%npy - ntiles = Atm(mytile)%gridstruct%ntiles_g - tile = Atm(mytile)%tile - - if (Atm(mytile)%flagstruct%npz /= plev) then - write(errmsg,*) 'FV3 dycore levels (npz),',Atm(mytile)%flagstruct%npz,' do not match model levels (plev)',plev - call endrun(sub//':'//errmsg) - end if - - ! Get file handle for initial file - fh_ini => initial_file_get_id() - - ! Initialize hybrid coordinate arrays - call hycoef_init(fh_ini) - - ! Initialize reference pressures - call ref_pres_init(hypi, hypm, nprlev) - - ! Hybrid coordinate info for FV grid object - Atm(mytile)%ks = plev - do k = 1, plev+1 - Atm(mytile)%ak(k) = hyai(k) * 1.e5_r8 - Atm(mytile)%bk(k) = hybi(k) - if ( Atm(mytile)%bk(k) == 0._r8) Atm(mytile)%ks = k-1 - end do - Atm(mytile)%ptop = Atm(mytile)%ak(1) - - ! Define the CAM grids - call define_cam_grids(Atm) - - ! Define block index arrays that are part of dyn_in and - ! global array for mapping columns to block decompositions - - allocate(mygindex(is:ie,js:je)) - allocate(mylindex(is:ie,js:je)) - - nx=npx-1 - ny=npy-1 - - n = 1 - do j = js, je - do i = is, ie - mygindex(i,j)=((j-1)*(npx-1)+i)+((npx-1)*(npy-1)*(tile-1)) - mylindex(i,j)=n - n = n + 1 - end do - end do - - ! create globalID index on block decomp - allocate(gindex_g(nx,ny,ntiles)) - if (masterproc) write(iulog, *) 'INFO: Non-scalable action: Allocating global blocks in FV3 dycore.(gindex_g)' - gindex_g(is:ie,js:je,tile)=mygindex(is:ie,js:je) - call mp_gather(gindex_g, is, ie, js, je, nx, ny, ntiles) - call mp_bcst(gindex_g, nx, ny, ntiles) - - ! create global blockID index on block decomp - if (masterproc) write(iulog, *) 'INFO: Non-scalable action: Allocating global blocks in FV3 dycore.(blkidx_g)' - allocate(blkidx_g(nx,ny,ntiles)) - blkidx_g(is:ie,js:je,tile)= mpp_pe() + 1 - call mp_gather(blkidx_g, is, ie, js, je, nx ,ny, ntiles) - call mp_bcst(blkidx_g, nx, ny, ntiles) - - ! create global block index on block decomp - if (masterproc) write(iulog, *) 'INFO: Non-scalable action: Allocating global blocks in FV3 dycore.(locidx_g)' - allocate(locidx_g(nx,ny,ntiles)) - locidx_g(is:ie,js:je,tile)= mylindex(is:ie,js:je) - call mp_gather(locidx_g, is, ie, js, je, nx ,ny, ntiles) - call mp_bcst(locidx_g, nx, ny, ntiles) - -end subroutine dyn_grid_init - -!======================================================================= - -subroutine get_block_bounds_d(block_first, block_last) - - ! Return first and last indices used in global block ordering - - use spmd_utils, only : npes - - ! arguments - integer, intent(out) :: block_first ! first (global) index used for blocks - integer, intent(out) :: block_last ! last (global) index used for blocks - !---------------------------------------------------------------------------- - - block_first = 1 - block_last = npes - -end subroutine get_block_bounds_d - -!======================================================================= - -subroutine get_block_gcol_d(blockid, size, cdex) - - ! Return number of dynamics columns in indicated block - - use fv_mp_mod, only: mp_bcst - use mpp_mod, only: mpp_npes, mpp_gather - - ! arguments - integer, intent(in) :: blockid ! global block id - integer, intent(in) :: size ! array size - integer, intent(out):: cdex(size) ! global column indices - - ! Local variables - integer, parameter :: be_arrlen = 5 - - real(r8),allocatable :: rtmp(:) - real(r8) :: block_extents(be_arrlen) - integer, allocatable :: be_size(:) - integer :: i, j, n,is,ie,js,je,tile,npes - !---------------------------------------------------------------------------- - !--- get block extents for each task/pe - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - - if (.not. allocated(block_extents_g)) then - npes=mpp_npes() - allocate(block_extents_g(be_arrlen,npes)) - allocate(rtmp(be_arrlen*npes)) - allocate(be_size(npes)) - be_size(:)=be_arrlen - block_extents(1)=is - block_extents(2)=ie - block_extents(3)=js - block_extents(4)=je - block_extents(5)=Atm(mytile)%tile - - call mpp_gather(block_extents,be_arrlen,rtmp,be_size) - call mp_bcst(rtmp,be_arrlen*npes) - block_extents_g=reshape(rtmp,(/be_arrlen,npes/)) - - deallocate(rtmp) - deallocate(be_size) - end if - - is=block_extents_g(1,blockid) - ie=block_extents_g(2,blockid) - js=block_extents_g(3,blockid) - je=block_extents_g(4,blockid) - tile=block_extents_g(5,blockid) - - if (size .ne. (ie - is + 1) * (je - js + 1)) then - call endrun ('get_block_gcol_d: block sizes are not consistent.') - end if - ! the following algorithm for cdex calculates global ids for a block - ! given the tile,and i,j column locations on tile. - n=1 - do j = js, je - do i = is, ie - cdex(n)= ((j-1)*(npx-1)+i)+((npx-1)*(npy-1)*(tile-1)) - n=n+1 - end do - end do - -end subroutine get_block_gcol_d - -!======================================================================= - -integer function get_block_gcol_cnt_d(blockid) - - ! Return number of dynamics columns in indicated block - - ! arguments - integer, intent(in) :: blockid - !---------------------------------------------------------------------------- - - get_block_gcol_cnt_d=count(blkidx_g == blockid) - -end function get_block_gcol_cnt_d - -!======================================================================= - -integer function get_block_lvl_cnt_d(blockid, bcid) - - ! Return number of levels in indicated column. If column - ! includes surface fields, then it is defined to also - ! include level 0. - - use pmgrid, only: plevp - - ! arguments - integer, intent(in) :: blockid ! global block id - integer, intent(in) :: bcid ! column index within block - !---------------------------------------------------------------------------- - - get_block_lvl_cnt_d = plevp - -end function get_block_lvl_cnt_d - -!======================================================================= - -subroutine get_block_levels_d(blockid, bcid, lvlsiz, levels) - - use pmgrid, only: plev - - ! Return level indices in indicated column. If column - ! includes surface fields, then it is defined to also - ! include level 0. - - ! arguments - integer, intent(in) :: blockid ! global block id - integer, intent(in) :: bcid ! column index within block - integer, intent(in) :: lvlsiz ! dimension of levels array - integer, intent(out) :: levels(lvlsiz) ! levels indices for block - - ! local variables - integer :: k - character(len=128) :: errmsg - !--------------------------------------------------------------------------- - - if (lvlsiz < plev + 1) then - write(errmsg,*) 'levels array not large enough (', lvlsiz,' < ',plev + 1,')' - call endrun('GET_BLOCK_LEVELS_D: '//trim(errmsg)) - else - do k = 0, plev - levels(k+1) = k - enddo - do k = plev + 2, lvlsiz - levels(k) = -1 - enddo - end if - -end subroutine get_block_levels_d - -!======================================================================= - -integer function get_block_owner_d(blockid) - - ! Return id of processor that "owns" the indicated block - - ! arguments - integer, intent(in) :: blockid ! global block id - - get_block_owner_d = blockid - 1 - -end function get_block_owner_d - -!======================================================================= - -subroutine get_gcol_block_d(gcol, cnt, blockid, bcid, localblockid) - - ! Return global block index and local column index for given global column index. - ! - ! The FV3 dycore assigns each global column to a singe element. So cnt is assumed - ! to be 1. - - use dimensions_mod, only: npx, npy - use fv_mp_mod, only: mp_gather, mp_bcst - - ! arguments - integer, intent(in) :: gcol ! global column index - integer, intent(in) :: cnt ! size of blockid and bcid arrays - integer, intent(out) :: blockid(cnt) ! block index - integer, intent(out) :: bcid(cnt) ! column index within block - integer, intent(out), optional :: localblockid(cnt) - - ! local variables - integer :: tot - integer :: ijk(3) - !---------------------------------------------------------------------------- - - if (cnt /= 1) then - call endrun ('get_gcol_block_d: cnt is not equal to 1:.') - end if - tot=(npx-1)*(npy-1)*6 - if (gcol < 1.or.gcol > tot) then - call endrun ('get_gcol_block_d: global column number is out of bounds') - else - - ijk=maxloc(blkidx_g,mask=gindex_g == gcol) - blockid(1) = blkidx_g(ijk(1),ijk(2),ijk(3)) - - ijk=maxloc(locidx_g,mask=gindex_g == gcol) - bcid(1) = locidx_g(ijk(1),ijk(2),ijk(3)) - end if - - if (present(localblockid)) then - localblockid(cnt) = 1 - end if - -end subroutine get_gcol_block_d - -!======================================================================= - -integer function get_gcol_block_cnt_d(gcol) - - ! Return number of blocks containg data for the vertical column with the - ! given global column index. - - ! For FV3 dycore each column is contained in a single block, so this routine - ! always returns 1. - - ! arguments - integer, intent(in) :: gcol ! global column index - !---------------------------------------------------------------------------- - - get_gcol_block_cnt_d = 1 - -end function get_gcol_block_cnt_d - -!======================================================================= - -subroutine get_horiz_grid_d(nxy, clat_d_out, clon_d_out, area_d_out, wght_d_out, lat_d_out, lon_d_out) - - ! Return global arrays of latitude and longitude (in radians), column - ! surface area (in radians squared) and surface integration weights for - ! global column indices that will be passed to/from physics - - ! arguments - integer, intent(in) :: nxy ! array sizes - real(r8), intent(out), optional :: clat_d_out(:) ! column latitudes - real(r8), intent(out), optional :: clon_d_out(:) ! column longitudes - real(r8), intent(out), optional :: area_d_out(:) ! column surface area - real(r8), intent(out), optional :: wght_d_out(:) ! column integration - real(r8), intent(out), optional :: lat_d_out(:) ! column degree latitudes - real(r8), intent(out), optional :: lon_d_out(:) ! column degree longitudes - - ! local variables - character(len=*), parameter :: sub = 'get_horiz_grid_d' - real(r8), allocatable :: tmparr(:,:) - real(r8), pointer :: area(:,:) - real(r8), pointer :: agrid(:,:,:) - integer :: is,ie,js,je - !---------------------------------------------------------------------------- - - area => Atm(mytile)%gridstruct%area_64 - agrid => Atm(mytile)%gridstruct%agrid_64 - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - - if (present(clon_d_out)) then - if (size(clon_d_out) /= nxy) call endrun(sub//': bad clon_d_out array size') - call create_global(is,ie,js,je,agrid(is:ie,js:je,1), clon_d_out) - end if - if (present(clat_d_out)) then - if (size(clat_d_out) /= nxy) call endrun(sub//': bad clat_d_out array size') - call create_global(is,ie,js,je,agrid(is:ie,js:je,2), clat_d_out) - end if - if (present(area_d_out).or.present(wght_d_out)) then - allocate(tmparr(is:ie,js:je)) - tmparr(is:ie,js:je) = area (is:ie,js:je) / (rearth * rearth) - if (present(area_d_out)) then - if (size(area_d_out) /= nxy) call endrun(sub//': bad area_d_out array size') - call create_global(is,ie,js,je,tmparr, area_d_out) - end if - if (present(wght_d_out)) then - if (size(wght_d_out) /= nxy) call endrun(sub//': bad wght_d_out array size') - call create_global(is,ie,js,je,tmparr, wght_d_out) - end if - deallocate(tmparr) - end if - if (present(lon_d_out)) then - if (size(lon_d_out) /= nxy) call endrun(sub//': bad clon_d_out array size') - call create_global(is,ie,js,je,agrid(is:ie,js:je,1), lon_d_out) - lon_d_out=lon_d_out*rad2deg - end if - if (present(lat_d_out)) then - if (size(lat_d_out) /= nxy) call endrun(sub//': bad clat_d_out array size') - call create_global(is,ie,js,je,agrid(is:ie,js:je,2), lat_d_out) - lat_d_out=lat_d_out*rad2deg - end if - - end subroutine get_horiz_grid_d - -!======================================================================= - -subroutine get_horiz_grid_dim_d(hdim1_d, hdim2_d) - - ! Returns declared horizontal dimensions of computational grid. - ! For non-lon/lat grids, declare grid to be one-dimensional, - - use dimensions_mod, only: npx,npy,ntiles - - ! arguments - integer, intent(out) :: hdim1_d ! first horizontal dimension - integer, intent(out), optional :: hdim2_d ! second horizontal dimension - !----------------------------------------------------------------------- - - hdim1_d = (npx-1)*(npy-1)*ntiles - if (present(hdim2_d)) hdim2_d = 1 - -end subroutine get_horiz_grid_dim_d - -!======================================================================= - -subroutine define_cam_grids(Atm) - - ! Create grid objects on the dynamics decomposition for grids used by - ! the dycore. The decomposed grid object contains data for the elements - ! in each task and information to map that data to the global grid. - ! - ! Notes on dynamic memory management: - ! - ! . Coordinate values and the map passed to the horiz_coord_create - ! method are copied to the object. The memory may be deallocated - ! after the object is created. - ! - ! . The area values passed to cam_grid_attribute_register are only pointed - ! to by the attribute object, so that memory cannot be deallocated. But the - ! map is copied. - ! - ! . The grid_map passed to cam_grid_register is just pointed to. - ! Cannot be deallocated. - - use cam_grid_support, only: horiz_coord_t, horiz_coord_create - use cam_grid_support, only: cam_grid_register, cam_grid_attribute_register - use fv_grid_utils_mod, only: mid_pt_sphere - use mpp_mod, only: mpp_pe - use physconst, only: rearth - - ! arguments - type(fv_atmos_type), target, intent(in) :: Atm(:) - - ! local variables - type(horiz_coord_t), pointer :: lat_coord - type(horiz_coord_t), pointer :: lon_coord - - integer(iMap), pointer :: grid_map(:,:) - - integer, allocatable, target, dimension(:,:) :: mygid, mygid_ew,mygid_ns - integer :: mybindex - integer :: i, j, mapind,is,ie,js,je,isd,ied,jsd,jed,tile - real(r8), pointer, dimension(:,:,:) :: agrid - real(r8), pointer, dimension(:,:,:) :: grid - real(r8), pointer, dimension(:,:) :: area - real(r8), pointer :: area_ffsl(:) !fv3 cell centered grid area in sq radians - real(r8), pointer :: pelon_deg(:) - real(r8), pointer :: pelat_deg(:) - real(r8), pointer :: pelon_deg_ew(:) - real(r8), pointer :: pelat_deg_ew(:) - real(r8), pointer :: pelon_deg_ns(:) - real(r8), pointer :: pelat_deg_ns(:) - real(r8) :: lonrad,latrad - integer(iMap), pointer :: pemap(:) - integer(iMap), pointer :: pemap_ew(:) - integer(iMap), pointer :: pemap_ns(:) - integer :: iend, jend - - !----------------------------------------------------------------------- - - area => Atm(mytile)%gridstruct%area_64 - agrid => Atm(mytile)%gridstruct%agrid_64 - grid => Atm(mytile)%gridstruct%grid_64 - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - isd = Atm(mytile)%bd%isd - ied = Atm(mytile)%bd%ied - jsd = Atm(mytile)%bd%jsd - jed = Atm(mytile)%bd%jed - tile = Atm(mytile)%tile - - allocate(area_ffsl((ie-is+1)*(je-js+1))) - allocate(grid_ew(isd:ied+1,jsd:jed,2)) - allocate(grid_ns(isd:ied,jsd:jed+1,2)) - allocate(pelon_deg((ie-is+1)*(je-js+1))) - allocate(pelon_deg_ns((ie-is+1)*(je-js+2))) - allocate(pelon_deg_ew((ie-is+2)*(je-js+1))) - allocate(pelat_deg((ie-is+1)*(je-js+1))) - allocate(pelat_deg_ew((ie-is+2)*(je-js+1))) - allocate(pelat_deg_ns((ie-is+1)*(je-js+2))) - allocate(pemap((ie-is+1)*(je-js+1))) - allocate(pemap_ew((ie-is+2)*(je-js+1))) - allocate(pemap_ns((ie-is+1)*(je-js+2))) - - do j=jsd,jed - do i=isd,ied+1 - call mid_pt_sphere(grid(i, j,1:2), grid(i, j+1,1:2), grid_ew(i,j,:)) - end do - end do - - do j=jsd,jed+1 - do i=isd,ied - call mid_pt_sphere(grid(i,j ,1:2), grid(i+1,j ,1:2), grid_ns(i,j,:)) - end do - end do - - allocate(mygid(is:ie,js:je)) - allocate(mygid_ew(is:ie+1,js:je)) - allocate(mygid_ns(is:ie,js:je+1)) - - mygid=0 - - mybindex = mpp_pe() + 1 - - do j = js, je - do i = is, ie - mygid(i,j)=((j-1)*(npx-1)+i)+((npx-1)*(npy-1)*(tile-1)) - end do - end do - - ! calculate local portion of global NS index array - ! unique global indexing bottom left to top right of each tile consecutively. Dups reported as 0 - ! North tile edges of 2,4,6 are duplicates of south edge of 3,5,1 and are reported as 0 in mygid array - mygid_ns=0 - if (je+1 == npy) then - jend = je+mod(tile,2) - else - jend = je+1 - end if - do j = js, jend - do i = is, ie - mygid_ns(i,j)=(i-1)*(npy-(mod(tile-1,2))) + j + (int((tile-1)/2)*(npx-1)*(npy-1)) + (int(tile/2)*(npx-1)*(npy)) - end do - end do - ! appropriate tile boundaries already 0'd need to - ! zero inner tile je+1 boundaries (These are also repeated points between tasks in ns direction)) - if (je+1 /= npy) mygid_ns(is:ie,je+1)=0 - - ! calculate local portion of global EW index array - ! unique global indexing bottom left to top right of each tile consecutively. Dups reported as 0 - ! East tile edges of 1,3,5 are duplicates of west edge of 2,4,6 and are reported as 0 in mygid array - mygid_ew=0 - if (ie+1 == npx) then - iend=ie+mod(tile-1,2) - else - iend=ie+1 - end if - do j = js, je - do i = is, iend - mygid_ew(i,j)=(j-1)*(npx-(mod(tile,2))) + i + (int(tile/2)*(npx-1)*(npy-1)) + (int((tile-1)/2)*(npx)*(npy-1)) - end do - end do - - ! appropriate east tile boundaries already 0'd from above need to - ! zero inner tile ie+1 boundaries on appropriate processors - ! (These are also repeated points between tasks in ew direction) - if (ie+1 /= npx) mygid_ew(ie+1,js:je)=0 - - !----------------------- - ! Create FFSL grid object - !----------------------- - - ! Calculate the mapping between FFSL points and file order (tile1 thru tile6) - mapind = 1 - do j = js, je - do i = is, ie - pelon_deg(mapind) = agrid(i,j,1) * rad2deg - pelat_deg(mapind) = agrid(i,j,2) * rad2deg - area_ffsl(mapind) = area(i,j)/(rearth*rearth) - pemap(mapind) = mygid(i,j) - mapind = mapind + 1 - end do - end do - - mapind = 1 - do j = js, je - do i = is, ie+1 - lonrad=grid_ew(i,j,1) - latrad=grid_ew(i,j,2) - pelon_deg_ew(mapind) = lonrad * rad2deg - pelat_deg_ew(mapind) = latrad * rad2deg - pemap_ew(mapind) = mygid_ew(i,j) - mapind = mapind + 1 - end do - end do - - mapind = 1 - do j = js, je+1 - do i = is, ie - lonrad=grid_ns(i,j,1) - latrad=grid_ns(i,j,2) - pelon_deg_ns(mapind) = lonrad * rad2deg - pelat_deg_ns(mapind) = latrad * rad2deg - pemap_ns(mapind) = mygid_ns(i,j) - mapind = mapind + 1 - end do - end do - - allocate(grid_map(3, (ie-is+1)*(je-js+1))) - grid_map = 0 - mapind = 1 - do j = js, je - do i = is, ie - grid_map(1, mapind) = i - grid_map(2, mapind) = j - grid_map(3, mapind) = pemap(mapind) - mapind = mapind + 1 - end do - end do - - ! output local and global uniq points - uniqpts_glob=(npx-1)*(npy-1)*6 - - ! with FV3 if the initial file uses the horizontal dimension 'ncol' rather than - ! 'ncol_d' then we need a grid object with the names ncol,lat,lon to read it. - ! Create that grid object here. - - lat_coord => horiz_coord_create('lat', 'ncol', uniqpts_glob, 'latitude', & - 'degrees_north', 1, size(pelat_deg), pelat_deg, map=pemap) - lon_coord => horiz_coord_create('lon', 'ncol', uniqpts_glob, 'longitude', & - 'degrees_east', 1, size(pelon_deg), pelon_deg, map=pemap) - - ! register physics cell-center/A-grid - call cam_grid_register(ini_grid_name, ini_decomp, lat_coord, lon_coord, & - grid_map, block_indexed=.false., unstruct=.true.) - call cam_grid_attribute_register(ini_grid_name, 'cell', '', 1) - call cam_grid_attribute_register(ini_grid_name, 'area', 'cam cell center areas', & - 'ncol', area_ffsl, map=pemap) - nullify(lat_coord) - nullify(lon_coord) - - ! create and register dynamic A-grid, src_in(/1,2/) allows ilev,jlev,nlev ordering for restart IO - lat_coord => horiz_coord_create('lat_d', 'ncol_d', uniqpts_glob, 'latitude', & - 'degrees_north', 1, size(pelat_deg), pelat_deg, map=pemap) - lon_coord => horiz_coord_create('lon_d', 'ncol_d', uniqpts_glob, 'longitude', & - 'degrees_east', 1, size(pelon_deg), pelon_deg, map=pemap) - - call cam_grid_register('FFSL', dyn_decomp, lat_coord, lon_coord, & - grid_map, block_indexed=.false., unstruct=.true.,src_in=(/1,2/)) - call cam_grid_attribute_register('FFSL', 'cell', '', 1) - call cam_grid_attribute_register('FFSL', 'area_d', 'FFSL grid areas', & - 'ncol_d', area_ffsl, map=pemap) - - ! register grid for writing dynamics A-Grid fields in history files - call cam_grid_register('FFSLHIST', dyn_decomp_hist, lat_coord, lon_coord, & - grid_map, block_indexed=.false., unstruct=.true.) - call cam_grid_attribute_register('FFSLHIST', 'cell', '', 1) - call cam_grid_attribute_register('FFSLHIST', 'area_d', 'FFSLHIST grid areas', & - 'ncol_d', area_ffsl, map=pemap) - - ! grid_map cannot be deallocated as the cam_filemap_t object just points - ! to it. It can be nullified. - nullify(grid_map) - ! lat_coord and lon_coord belong to grid so can't be deleted. It can be nullified - nullify(lat_coord) - nullify(lon_coord) - ! area_ffsl cannot be deallocated as the attribute object is just pointing - ! to that memory. It can be nullified since the attribute object has - ! the reference. - nullify(area_ffsl) - - - ! global EW uniq points - uniqpts_glob_ew=((2*npx)-1)*(npy-1)*3 - - lat_coord => horiz_coord_create('lat_d_ew', 'ncol_d_ew', uniqpts_glob_ew, 'latitude', & - 'degrees_north', 1, size(pelat_deg_ew), pelat_deg_ew, map=pemap_ew) - lon_coord => horiz_coord_create('lon_d_ew', 'ncol_d_ew', uniqpts_glob_ew, 'longitude', & - 'degrees_east', 1, size(pelon_deg_ew), pelon_deg_ew, map=pemap_ew) - - allocate(grid_map(3, (ie-is+2)*(je-js+1))) - grid_map = 0 - mapind = 1 - do j = js, je - do i = is, ie+1 - grid_map(1, mapind) = i - grid_map(2, mapind) = j - grid_map(3, mapind) = pemap_ew(mapind) - mapind = mapind + 1 - end do - end do - - ! register dynamic D-grid, src_in(/1,2/) allows ilev,jlev,nlev ordering for restart IO - call cam_grid_register('FFSL_EW', dyn_decomp_ew, lat_coord, lon_coord, & - grid_map, block_indexed=.false., unstruct=.true.,src_in=(/1,2/)) - call cam_grid_attribute_register('FFSL_EW', 'cell', '', 1) - - ! register grid for writing dynamics D-Grid fields in history files - call cam_grid_register('FFSLHIST_EW', dyn_decomp_hist_ew, lat_coord, lon_coord, & - grid_map, block_indexed=.false., unstruct=.true.) - call cam_grid_attribute_register('FFSLHIST_EW', 'cell', '', 1) - - ! grid_map cannot be deallocated as the cam_filemap_t object just points - ! to it. It can be nullified. - nullify(grid_map) - ! lat_coord and lon_coord belong to grid so can't be deleted. It can be nullified - nullify(lat_coord) ! Belongs to grid - nullify(lon_coord) ! Belongs to grid - - - ! output local and global uniq points - uniqpts_glob_ns=((2*npy)-1)*(npx-1)*3 - - lat_coord => horiz_coord_create('lat_d_ns', 'ncol_d_ns', uniqpts_glob_ns, 'latitude', & - 'degrees_north', 1, size(pelat_deg_ns), pelat_deg_ns, map=pemap_ns) - lon_coord => horiz_coord_create('lon_d_ns', 'ncol_d_ns', uniqpts_glob_ns, 'longitude', & - 'degrees_east', 1, size(pelon_deg_ns), pelon_deg_ns, map=pemap_ns) - - allocate(grid_map(3, (ie-is+1)*(je-js+2))) - grid_map = 0 - mapind = 1 - do j = js, je+1 - do i = is, ie - grid_map(1, mapind) = i - grid_map(2, mapind) = j - grid_map(3, mapind) = pemap_ns(mapind) - mapind = mapind + 1 - end do - end do - - ! register dynamic D-grid, src_in(/1,2/) allows ilev,jlev,nlev ordering for restart IO - call cam_grid_register('FFSL_NS', dyn_decomp_ns, lat_coord, lon_coord, & - grid_map, block_indexed=.false., unstruct=.true.,src_in=(/1,2/)) - call cam_grid_attribute_register('FFSL_NS', 'cell', '', 1) - - ! register grid for writing dynamics D-Grid fields in history files - call cam_grid_register('FFSLHIST_NS', dyn_decomp_hist_ns, lat_coord, lon_coord, & - grid_map, block_indexed=.false., unstruct=.true.) - call cam_grid_attribute_register('FFSLHIST_NS', 'cell', '', 1) - - ! grid_map cannot be deallocated as the cam_filemap_t object just points - ! to it. It can be nullified. - nullify(grid_map) - ! lat_coord and lon_coord belong to grid so can't be deleted. It can be nullified - nullify(lat_coord) ! Belongs to grid - nullify(lon_coord) ! Belongs to grid - - deallocate(pelon_deg) - deallocate(pelat_deg) - deallocate(pelon_deg_ns) - deallocate(pelat_deg_ns) - deallocate(pelon_deg_ew) - deallocate(pelat_deg_ew) - deallocate(pemap) - deallocate(pemap_ew) - deallocate(pemap_ns) - deallocate(mygid) - deallocate(mygid_ew) - deallocate(mygid_ns) - -end subroutine define_cam_grids - -!========================================================================================= - -subroutine physgrid_copy_attributes_d(gridname, grid_attribute_names) - - ! create list of attributes for the physics grid that should be copied - ! from the corresponding grid object on the dynamics decomposition - - use cam_grid_support, only: max_hcoordname_len - - ! arguments - character(len=max_hcoordname_len), intent(out) :: gridname - character(len=max_hcoordname_len), pointer, intent(out) :: grid_attribute_names(:) - !----------------------------------------------------------------------- - - gridname = 'FFSL' - allocate(grid_attribute_names(1)) - ! For standard CAM-FV3, we need to copy the area attribute. - ! For physgrid, the physics grid will create area - grid_attribute_names(1) = 'cell' - -end subroutine physgrid_copy_attributes_d - -!======================================================================= - -integer function get_dyn_grid_parm(name) result(ival) - - ! This function is in the process of being deprecated, but is still needed - ! as a dummy interface to satisfy external references from some chemistry routines. - - use pmgrid, only: plon, plev, plat, plevp - - character(len=*), intent(in) :: name - integer is,ie,js,je - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - - if (name == 'plat') then - ival = plat - else if (name == 'plon') then - ival = (je-js+1)*(ie-is+1) - else if (name == 'plev') then - ival = plev - else if (name == 'plevp') then - ival = plevp - else - call endrun('get_dyn_grid_parm: undefined name: '//adjustl(trim(name))) - end if - -end function get_dyn_grid_parm - -!======================================================================= - -function get_dyn_grid_parm_real1d(name) result(rval) - - ! This routine is not used for FV3, but still needed as a dummy interface to satisfy - ! references from mo_synoz.F90 and phys_gmean.F90 - - ! arguments - character(len=*), intent(in) :: name - real(r8), pointer :: rval(:) - !---------------------------------------------------------------------------- - - if(name == 'w') then - call endrun('get_dyn_grid_parm_real1d: w not defined') - else if(name == 'clat') then - call endrun('get_dyn_grid_parm_real1d: clat not supported, use get_horiz_grid_d') - else if(name == 'latdeg') then - call endrun('get_dyn_grid_parm_real1d: latdeg not defined') - else - nullify(rval) - end if - -end function get_dyn_grid_parm_real1d - -!========================================================================================= - -subroutine dyn_grid_get_colndx( igcol, ncols, owners, indx, jndx) - use spmd_utils, only: iam - - ! For each global column index return the owning task. If the column is owned - ! by this task, then also return the MPI process indicies for that column - - - ! arguments - integer, intent(in) :: ncols - integer, intent(in) :: igcol(ncols) - integer, intent(out) :: owners(ncols) - integer, intent(out) :: indx(ncols) - integer, intent(out) :: jndx(ncols) - - ! local variables - integer :: i,is,ie,js,je - integer :: blockid(1), bcid(1), lclblockid(1), ind(2) - !---------------------------------------------------------------------------- - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - - do i = 1,ncols - - call get_gcol_block_d( igcol(i), 1, blockid, bcid, lclblockid ) - owners(i) = get_block_owner_d(blockid(1)) - - if ( iam == owners(i) ) then - if (minval(abs(bcid(1)-mylindex)) == 0) then - ind = minloc(abs(bcid(1)-mylindex)) - indx(i) = is+ind(1)-1 - jndx(i) = js+ind(2)-1 - end if - else - indx(i) = -1 - jndx(i) = -1 - endif - - end do - -end subroutine dyn_grid_get_colndx - -!======================================================================= - -subroutine dyn_grid_get_elem_coords(ie, rlon, rlat, cdex) - - ! Returns coordinates of a specified block element of the dyn grid - ! - - ! arguments - integer, intent(in) :: ie ! block element index - real(r8),optional, intent(out) :: rlon(:) ! longitudes of the columns in the element - real(r8),optional, intent(out) :: rlat(:) ! latitudes of the columns in the element - integer, optional, intent(out) :: cdex(:) ! global column index - !---------------------------------------------------------------------------- - - call endrun('dyn_grid_get_elem_coords: currently not avaliable.') - -end subroutine dyn_grid_get_elem_coords - -!========================================================================================= - -subroutine create_global(is,ie,js,je,arr_d, global_out) - - ! Gather global array of columns for the physics grid, - ! reorder to global column order, then broadcast it to all tasks. - - use fv_mp_mod, only: mp_gather, mp_bcst - - ! arguments - integer, intent(in) :: is, ie, js, je - real(r8), intent(in) :: arr_d(is:ie,js:je) ! input array - real(r8), intent(out) :: global_out(:) ! global output in block order - - ! local variables - integer :: i, j, k - integer :: tile - real(r8), allocatable :: globid(:,:,:) - real(r8), allocatable :: globarr_tmp(:,:,:) - !---------------------------------------------------------------------------- - - tile = Atm(mytile)%tile - - if (.not. allocated(globarr_tmp)) then - if (masterproc) write(iulog, *) 'INFO: Non-scalable action: Allocating global blocks in FV3 dycore.(globarr_tmp)' - allocate(globarr_tmp(npx-1, npy-1, ntiles)) - end if - - globarr_tmp(is:ie,js:je,tile)=arr_d(is:ie,js:je) - call mp_gather(globarr_tmp, is, ie, js, je, npx-1, npy-1, ntiles) - if (masterproc) then - do k = 1, ntiles - do j = 1, npy-1 - do i = 1, npx-1 - global_out(gindex_g(i,j,k)) = globarr_tmp(i,j,k) - end do - end do - end do - end if - call mp_bcst(global_out, (npx-1)*(npy-1)*ntiles) - deallocate(globarr_tmp) - -end subroutine create_global - -end module dyn_grid diff --git a/src/dynamics/fv3/interp_mod.F90 b/src/dynamics/fv3/interp_mod.F90 deleted file mode 100644 index e517031ea8..0000000000 --- a/src/dynamics/fv3/interp_mod.F90 +++ /dev/null @@ -1,67 +0,0 @@ -module interp_mod - ! inline interpolation routines not implemented yet - use shr_kind_mod, only : r8=>shr_kind_r8 - use cam_abortutils, only : endrun - - implicit none - private - save - - public :: setup_history_interpolation - public :: set_interp_hfile - public :: write_interpolated - - interface write_interpolated - module procedure write_interpolated_scalar - module procedure write_interpolated_vector - end interface - integer, parameter :: nlat=0, nlon=0 -contains - - subroutine setup_history_interpolation(interp_ok, mtapes, interp_output, & - interp_info) - use cam_history_support, only: interp_info_t - - ! Dummy arguments - logical, intent(inout) :: interp_ok - integer, intent(in) :: mtapes - logical, intent(in) :: interp_output(:) - type(interp_info_t), intent(inout) :: interp_info(:) - - interp_ok = .false. - - end subroutine setup_history_interpolation - - subroutine set_interp_hfile(hfilenum, interp_info) - use cam_history_support, only: interp_info_t - - ! Dummy arguments - integer, intent(in) :: hfilenum - type(interp_info_t), intent(inout) :: interp_info(:) - call endrun('ERROR:set_interp_hfile - This routine is a stub, you shouldnt get here') - end subroutine set_interp_hfile - - subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp_type) - use pio, only : file_desc_t, var_desc_t - use shr_kind_mod, only : r8=>shr_kind_r8 - - type(file_desc_t), intent(inout) :: File - type(var_desc_t), intent(inout) :: varid - real(r8), intent(in) :: fld(:,:,:) - integer, intent(in) :: numlev, data_type, decomp_type - call endrun('ERROR:write_interpolated_scalar - This routine is a stub, you shouldnt get here') - - end subroutine write_interpolated_scalar - - subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, numlev, data_type, decomp_type) - use pio, only : file_desc_t, var_desc_t - - type(file_desc_t), intent(inout) :: File - type(var_desc_t), intent(inout) :: varidu, varidv - real(r8), intent(in) :: fldu(:,:,:), fldv(:,:,:) - integer, intent(in) :: numlev, data_type, decomp_type - call endrun('ERROR:write_interpolated_vector - This routine is a stub, you shouldnt get here') - - end subroutine write_interpolated_vector - -end module interp_mod diff --git a/src/dynamics/fv3/microphys/gfdl_cloud_microphys.F90 b/src/dynamics/fv3/microphys/gfdl_cloud_microphys.F90 deleted file mode 100644 index 9a18204651..0000000000 --- a/src/dynamics/fv3/microphys/gfdl_cloud_microphys.F90 +++ /dev/null @@ -1,4975 +0,0 @@ -!*********************************************************************** -!* GNU Lesser General Public License -!* -!* This file is part of the GFDL Cloud Microphysics. -!* -!* The GFDL Cloud Microphysics is free software: you can -!* redistribute it and/or modify it under the terms of the -!* GNU Lesser General Public License as published by the -!* Free Software Foundation, either version 3 of the License, or -!* (at your option) any later version. -!* -!* The GFDL Cloud Microphysics is distributed in the hope it will be -!* useful, but WITHOUT ANYWARRANTY; without even the implied warranty -!* of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -!* See the GNU General Public License for more details. -!* -!* You should have received a copy of the GNU Lesser General Public -!* License along with the GFDL Cloud Microphysics. -!* If not, see . -!*********************************************************************** - -!>@brief The module 'gfdl_cloud_microphys' contains the full GFDL cloud -!! microphysics (Chen and Lin 2013) \cite chen2013seasonal and (Zhou et al. 2019) \cite zhou2019toward. -!>@details The module is paired with 'fv_cmp', which performs the "fast" -!! processes -!>author Shian-Jiann Lin, Linjiong Zhou - -! ======================================================================= -! cloud micro - physics package for gfdl global cloud resolving model -! the algorithms are originally derived from lin et al 1983. most of the -! key elements have been simplified / improved. this code at this stage -! bears little to no similarity to the original lin mp in zetac. -! therefore, it is best to be called gfdl micro - physics (gfdl mp) . -! developer: Shian-Jiann lin, Linjiong Zhou -! ======================================================================= - -module gfdl_cloud_microphys_mod - USE module_mp_radar - ! use diag_manager_mod, only: register_diag_field, send_data - ! use time_manager_mod, only: time_type, get_time - ! use constants_mod, only: grav, rdgas, rvgas, cp_air, hlv, hlf, pi => pi_8 - ! use fms_mod, only: write_version_number, open_namelist_file, & - ! check_nml_error, file_exist, close_file - - implicit none - - private - - public gfdl_cloud_microphys_driver, gfdl_cloud_microphys_init, gfdl_cloud_microphys_end - public wqs1, wqs2, qs_blend, wqsat_moist, wqsat2_moist - public qsmith_init, qsmith, es2_table1d, es3_table1d, esw_table1d - public setup_con, wet_bulb - public cloud_diagnosis - - real :: missing_value = - 1.e10 - - logical :: module_is_initialized = .false. - logical :: qsmith_tables_initialized = .false. - - character (len = 17) :: mod_name = 'gfdl_cloud_microphys' - - real, parameter :: n0r = 8.0e6, n0s = 3.0e6, n0g = 4.0e6 - real, parameter :: rhos = 0.1e3, rhog = 0.4e3 - real, parameter :: grav = 9.80665 !< gfs: acceleration due to gravity - real, parameter :: rdgas = 287.05 !< gfs: gas constant for dry air - real, parameter :: rvgas = 461.50 !< gfs: gas constant for water vapor - real, parameter :: cp_air = 1004.6 !< gfs: heat capacity of dry air at constant pressure - real, parameter :: hlv = 2.5e6 !< gfs: latent heat of evaporation - real, parameter :: hlf = 3.3358e5 !< gfs: latent heat of fusion - real, parameter :: pi = 3.1415926535897931 !< gfs: ratio of circle circumference to diameter - - ! real, parameter :: rdgas = 287.04 ! gfdl: gas constant for dry air - - ! real, parameter :: cp_air = rdgas * 7. / 2. ! 1004.675, heat capacity of dry air at constant pressure - real, parameter :: cp_vap = 4.0 * rvgas !< 1846.0, heat capacity of water vapore at constnat pressure - ! real, parameter :: cv_air = 717.56 ! satoh value - real, parameter :: cv_air = cp_air - rdgas !< 717.55, heat capacity of dry air at constant volume - ! real, parameter :: cv_vap = 1410.0 ! emanuel value - real, parameter :: cv_vap = 3.0 * rvgas !< 1384.5, heat capacity of water vapor at constant volume - - ! the following two are from emanuel's book "atmospheric convection" - ! real, parameter :: c_ice = 2106.0 ! heat capacity of ice at 0 deg c: c = c_ice + 7.3 * (t - tice) - ! real, parameter :: c_liq = 4190.0 ! heat capacity of water at 0 deg c - - real, parameter :: c_ice = 1972.0 !< gfdl: heat capacity of ice at - 15 deg c - real, parameter :: c_liq = 4185.5 !< gfdl: heat capacity of water at 15 deg c - ! real, parameter :: c_liq = 4218.0 ! ifs: heat capacity of liquid at 0 deg c - - real, parameter :: eps = rdgas / rvgas ! 0.6219934995 - real, parameter :: zvir = rvgas / rdgas - 1. !< 0.6077338443 - - real, parameter :: t_ice = 273.16 !< freezing temperature - real, parameter :: table_ice = 273.16 !< freezing point for qs table - - ! real, parameter :: e00 = 610.71 ! gfdl: saturation vapor pressure at 0 deg c - real, parameter :: e00 = 611.21 !< ifs: saturation vapor pressure at 0 deg c - - real, parameter :: dc_vap = cp_vap - c_liq !< - 2339.5, isobaric heating / cooling - real, parameter :: dc_ice = c_liq - c_ice !< 2213.5, isobaric heating / colling - - real, parameter :: hlv0 = hlv !< gfs: evaporation latent heat coefficient at 0 deg c - ! real, parameter :: hlv0 = 2.501e6 ! emanuel appendix - 2 - real, parameter :: hlf0 = hlf !< gfs: fussion latent heat coefficient at 0 deg c - ! real, parameter :: hlf0 = 3.337e5 ! emanuel - - real, parameter :: lv0 = hlv0 - dc_vap * t_ice!< 3.13905782e6, evaporation latent heat coefficient at 0 deg k - real, parameter :: li00 = hlf0 - dc_ice * t_ice!< - 2.7105966e5, fusion latent heat coefficient at 0 deg k - - real, parameter :: d2ice = dc_vap + dc_ice !< - 126, isobaric heating / cooling - real, parameter :: li2 = lv0 + li00 !< 2.86799816e6, sublimation latent heat coefficient at 0 deg k - - real, parameter :: qrmin = 1.e-8 ! min value for ??? - real, parameter :: qvmin = 1.e-20 !< min value for water vapor (treated as zero) - real, parameter :: qcmin = 1.e-12 !< min value for cloud condensates - - real, parameter :: vr_min = 1.e-3 !< min fall speed for rain - real, parameter :: vf_min = 1.e-5 !< min fall speed for cloud ice, snow, graupel - - real, parameter :: dz_min = 1.e-2 ! use for correcting flipped height - - real, parameter :: sfcrho = 1.2 !< surface air density - real, parameter :: rhor = 1.e3 !< density of rain water, lin83 - - real :: cracs, csacr, cgacr, cgacs, csacw, craci, csaci, cgacw, cgaci, cracw !< constants for accretions - real :: acco (3, 4) !< constants for accretions - real :: cssub (5), cgsub (5), crevp (5), cgfr (2), csmlt (5), cgmlt (5) - - real :: es0, ces0 - real :: pie, rgrav, fac_rc - real :: c_air, c_vap - - real :: lati, latv, lats, lat2, lcp, icp, tcp !< used in bigg mechanism and wet bulk - - real :: d0_vap !< the same as dc_vap, except that cp_vap can be cp_vap or cv_vap - real :: lv00 !< the same as lv0, except that cp_vap can be cp_vap or cv_vap - - ! cloud microphysics switchers - - integer :: icloud_f = 0 !< cloud scheme - integer :: irain_f = 0 !< cloud water to rain auto conversion scheme - - logical :: de_ice = .false. !< to prevent excessive build - up of cloud ice from external sources - logical :: sedi_transport = .true. !< transport of momentum in sedimentation - logical :: do_sedi_w = .false. !< transport of vertical motion in sedimentation - logical :: do_sedi_heat = .true. !< transport of heat in sedimentation - logical :: prog_ccn = .false. !< do prognostic ccn (yi ming's method) - logical :: do_qa = .true. !< do inline cloud fraction - logical :: rad_snow = .true. !< consider snow in cloud fraciton calculation - logical :: rad_graupel = .true. !< consider graupel in cloud fraction calculation - logical :: rad_rain = .true. !< consider rain in cloud fraction calculation - logical :: fix_negative = .false. !< fix negative water species - logical :: do_setup = .true. !< setup constants and parameters - logical :: p_nonhydro = .false. !< perform hydrosatic adjustment on air density - - real, allocatable :: table (:), table2 (:), table3 (:), tablew (:) - real, allocatable :: des (:), des2 (:), des3 (:), desw (:) - - logical :: tables_are_initialized = .false. - - ! logical :: master - ! integer :: id_rh, id_vtr, id_vts, id_vtg, id_vti, id_rain, id_snow, id_graupel, & - ! id_ice, id_prec, id_cond, id_var, id_droplets - real, parameter :: dt_fr = 8. !< homogeneous freezing of all cloud water at t_wfr - dt_fr - ! minimum temperature water can exist (moore & molinero nov. 2011, nature) - ! dt_fr can be considered as the error bar - - real :: p_min = 100. !< minimum pressure (pascal) for mp to operate - - ! slj, the following parameters are for cloud - resolving resolution: 1 - 5 km - - ! qi0_crt = 0.8e-4 - ! qs0_crt = 0.6e-3 - ! c_psaci = 0.1 - ! c_pgacs = 0.1 - - ! ----------------------------------------------------------------------- - !> namelist parameters - ! ----------------------------------------------------------------------- - - real :: cld_min = 0.05 !< minimum cloud fraction - real :: tice = 273.16 !< set tice = 165. to trun off ice - phase phys (kessler emulator) - - real :: t_min = 178. !< min temp to freeze - dry all water vapor - real :: t_sub = 184. !< min temp for sublimation of cloud ice - real :: mp_time = 150. !< maximum micro - physics time step (sec) - - ! relative humidity increment - - real :: rh_inc = 0.25 !< rh increment for complete evaporation of cloud water and cloud ice - real :: rh_inr = 0.25 !< rh increment for minimum evaporation of rain - real :: rh_ins = 0.25 !< rh increment for sublimation of snow - - ! conversion time scale - - real :: tau_r2g = 900. !< rain freezing during fast_sat - real :: tau_smlt = 900. !< snow melting - real :: tau_g2r = 600. !< graupel melting to rain - real :: tau_imlt = 600. !< cloud ice melting - real :: tau_i2s = 1000. !< cloud ice to snow auto - conversion - real :: tau_l2r = 900. !< cloud water to rain auto - conversion - real :: tau_v2l = 150. !< water vapor to cloud water (condensation) - real :: tau_l2v = 300. !< cloud water to water vapor (evaporation) - real :: tau_g2v = 900. !< graupel sublimation - real :: tau_v2g = 21600. !< graupel deposition -- make it a slow process - - ! horizontal subgrid variability - - real :: dw_land = 0.20 !< base value for subgrid deviation / variability over land - real :: dw_ocean = 0.10 !< base value for ocean - - ! prescribed ccn - - real :: ccn_o = 90. !< ccn over ocean (cm^ - 3) - real :: ccn_l = 270. !< ccn over land (cm^ - 3) - - real :: rthresh = 10.0e-6 !< critical cloud drop radius (micro m) - - ! ----------------------------------------------------------------------- - ! wrf / wsm6 scheme: qi_gen = 4.92e-11 * (1.e3 * exp (0.1 * tmp)) ** 1.33 - ! optimized: qi_gen = 4.92e-11 * exp (1.33 * log (1.e3 * exp (0.1 * tmp))) - ! qi_gen ~ 4.808e-7 at 0 c; 1.818e-6 at - 10 c, 9.82679e-5 at - 40c - ! the following value is constructed such that qc_crt = 0 at zero c and @ - 10c matches - ! wrf / wsm6 ice initiation scheme; qi_crt = qi_gen * min (qi_lim, 0.1 * tmp) / den - ! ----------------------------------------------------------------------- - - real :: sat_adj0 = 0.90 !< adjustment factor (0: no, 1: full) during fast_sat_adj - - real :: qc_crt = 5.0e-8 !< mini condensate mixing ratio to allow partial cloudiness - - real :: qi_lim = 1. !< cloud ice limiter to prevent large ice build up - - real :: ql_mlt = 2.0e-3 !< max value of cloud water allowed from melted cloud ice - real :: qs_mlt = 1.0e-6 !< max cloud water due to snow melt - - real :: ql_gen = 1.0e-3 !< max cloud water generation during remapping step if fast_sat_adj = .t. - real :: qi_gen = 1.82e-6 !< max cloud ice generation during remapping step - - ! cloud condensate upper bounds: "safety valves" for ql & qi - - real :: ql0_max = 2.0e-3 !< max cloud water value (auto converted to rain) - real :: qi0_max = 1.0e-4 !< max cloud ice value (by other sources) - - real :: qi0_crt = 1.0e-4 !< cloud ice to snow autoconversion threshold (was 1.e-4) - !! qi0_crt is highly dependent on horizontal resolution - real :: qr0_crt = 1.0e-4 !< rain to snow or graupel / hail threshold - !! lfo used * mixing ratio * = 1.e-4 (hail in lfo) - real :: qs0_crt = 1.0e-3 !< snow to graupel density threshold (0.6e-3 in purdue lin scheme) - - real :: c_paut = 0.55 !< autoconversion cloud water to rain (use 0.5 to reduce autoconversion) - real :: c_psaci = 0.02 !< accretion: cloud ice to snow (was 0.1 in zetac) - real :: c_piacr = 5.0 !< accretion: rain to ice: - real :: c_cracw = 0.9 !< rain accretion efficiency - real :: c_pgacs = 2.0e-3 !< snow to graupel "accretion" eff. (was 0.1 in zetac) - - ! decreasing clin to reduce csacw (so as to reduce cloud water --- > snow) - - real :: alin = 842.0 !< "a" in lin1983 - real :: clin = 4.8 !< "c" in lin 1983, 4.8 -- > 6. (to ehance ql -- > qs) - - ! fall velocity tuning constants: - - logical :: const_vi = .false. !< if .t. the constants are specified by v * _fac - logical :: const_vs = .false. !< if .t. the constants are specified by v * _fac - logical :: const_vg = .false. !< if .t. the constants are specified by v * _fac - logical :: const_vr = .false. !< if .t. the constants are specified by v * _fac - - ! good values: - - real :: vi_fac = 1. !< if const_vi: 1 / 3 - real :: vs_fac = 1. !< if const_vs: 1. - real :: vg_fac = 1. !< if const_vg: 2. - real :: vr_fac = 1. !< if const_vr: 4. - - ! upper bounds of fall speed (with variable speed option) - - real :: vi_max = 0.5 !< max fall speed for ice - real :: vs_max = 5.0 !< max fall speed for snow - real :: vg_max = 8.0 !< max fall speed for graupel - real :: vr_max = 12. !< max fall speed for rain - - ! cloud microphysics switchers - - logical :: fast_sat_adj = .false. !< has fast saturation adjustments - logical :: z_slope_liq = .true. !< use linear mono slope for autocconversions - logical :: z_slope_ice = .false. !< use linear mono slope for autocconversions - logical :: use_ccn = .false. !< must be true when prog_ccn is false - logical :: use_ppm = .false. !< use ppm fall scheme - logical :: mono_prof = .true. !< perform terminal fall with mono ppm scheme - logical :: mp_print = .false. !< cloud microphysics debugging printout - - ! real :: global_area = - 1. - - real :: log_10, tice0, t_wfr - - integer :: reiflag = 1 - ! 1: Heymsfield and Mcfarquhar, 1996 - ! 2: Wyser, 1998 - - logical :: tintqs = .false. !< use temperature in the saturation mixing in PDF - - real :: rewmin = 5.0, rewmax = 10.0 - real :: reimin = 10.0, reimax = 150.0 - real :: rermin = 10.0, rermax = 10000.0 - real :: resmin = 150.0, resmax = 10000.0 - real :: regmin = 300.0, regmax = 10000.0 - - ! ----------------------------------------------------------------------- - ! namelist - ! ----------------------------------------------------------------------- - - namelist / gfdl_cloud_microphysics_nml / & - mp_time, t_min, t_sub, tau_r2g, tau_smlt, tau_g2r, dw_land, dw_ocean, & - vi_fac, vr_fac, vs_fac, vg_fac, ql_mlt, do_qa, fix_negative, vi_max, & - vs_max, vg_max, vr_max, qs_mlt, qs0_crt, qi_gen, ql0_max, qi0_max, & - qi0_crt, qr0_crt, fast_sat_adj, rh_inc, rh_ins, rh_inr, const_vi, & - const_vs, const_vg, const_vr, use_ccn, rthresh, ccn_l, ccn_o, qc_crt, & - tau_g2v, tau_v2g, sat_adj0, c_piacr, tau_imlt, tau_v2l, tau_l2v, & - tau_i2s, tau_l2r, qi_lim, ql_gen, c_paut, c_psaci, c_pgacs, & - z_slope_liq, z_slope_ice, prog_ccn, c_cracw, alin, clin, tice, & - rad_snow, rad_graupel, rad_rain, cld_min, use_ppm, mono_prof, & - do_sedi_heat, sedi_transport, do_sedi_w, de_ice, icloud_f, irain_f, & - mp_print, reiflag, rewmin, rewmax, reimin, reimax, rermin, rermax, & - resmin, resmax, regmin, regmax, tintqs - - public & - mp_time, t_min, t_sub, tau_r2g, tau_smlt, tau_g2r, dw_land, dw_ocean, & - vi_fac, vr_fac, vs_fac, vg_fac, ql_mlt, do_qa, fix_negative, vi_max, & - vs_max, vg_max, vr_max, qs_mlt, qs0_crt, qi_gen, ql0_max, qi0_max, & - qi0_crt, qr0_crt, fast_sat_adj, rh_inc, rh_ins, rh_inr, const_vi, & - const_vs, const_vg, const_vr, use_ccn, rthresh, ccn_l, ccn_o, qc_crt, & - tau_g2v, tau_v2g, sat_adj0, c_piacr, tau_imlt, tau_v2l, tau_l2v, & - tau_i2s, tau_l2r, qi_lim, ql_gen, c_paut, c_psaci, c_pgacs, & - z_slope_liq, z_slope_ice, prog_ccn, c_cracw, alin, clin, tice, & - rad_snow, rad_graupel, rad_rain, cld_min, use_ppm, mono_prof, & - do_sedi_heat, sedi_transport, do_sedi_w, de_ice, icloud_f, irain_f, & - mp_print, reiflag, rewmin, rewmax, reimin, reimax, rermin, rermax, & - resmin, resmax, regmin, regmax, tintqs - -contains - -! ----------------------------------------------------------------------- -! the driver of the gfdl cloud microphysics -! ----------------------------------------------------------------------- - -!>@brief The subroutine 'gfdl_cloud_microphys_driver' executes the full GFDL -!! cloud microphysics. -subroutine gfdl_cloud_microphys_driver (qv, ql, qr, qi, qs, qg, qa, qn, & - qv_dt, ql_dt, qr_dt, qi_dt, qs_dt, qg_dt, qa_dt, pt_dt, pt, w, & - uin, vin, udt, vdt, dz, delp, area, dt_in, land, rain, snow, ice, & - graupel, hydrostatic, phys_hydrostatic, iis, iie, jjs, jje, kks, & - kke, ktop, kbot, seconds,p,lradar,refl_10cm,reset) - implicit none - - logical, intent (in) :: hydrostatic, phys_hydrostatic,lradar - integer, intent (in) :: iis, iie, jjs, jje !< physics window - integer, intent (in) :: kks, kke !< vertical dimension - integer, intent (in) :: ktop, kbot !< vertical compute domain - integer, intent (in) :: seconds - logical, intent (in) :: reset - - real, intent (in) :: dt_in !< physics time step - - real, intent (in), dimension (:, :) :: area !< cell area - real, intent (in), dimension (:, :) :: land !< land fraction - - real, intent (in), dimension (:, :, :) :: delp, dz, uin, vin, p - real, intent (in), dimension (:, :, :) :: pt, qv, ql, qr, qg, qa, qn - - real, intent (inout), dimension (:, :, :) :: qi, qs - real, intent (inout), dimension (:, :, :) :: pt_dt, qa_dt, udt, vdt, w - real, intent (inout), dimension (:, :, :) :: qv_dt, ql_dt, qr_dt - real, intent (inout), dimension (:, :, :) :: qi_dt, qs_dt, qg_dt - - real, intent (out), dimension (:, :, :) :: refl_10cm - real, intent (out), dimension (:, :) :: rain, snow, ice, graupel - - logical :: melti = .false. - ! logical :: used - - real :: mpdt, rdt, dts, convt, tot_prec - - integer :: i, j, k - integer :: is, ie, js, je !< physics window - integer :: ks, ke !< vertical dimension - integer :: days, ntimes, kflip - - real, dimension (iie - iis + 1, jje - jjs + 1) :: prec_mp, prec1, cond, w_var, rh0 - - real, dimension (iie - iis + 1, jje - jjs + 1, kke - kks + 1) :: vt_r, vt_s, vt_g, vt_i, qn2 - - real, dimension (size (pt, 1), size (pt, 3)) :: m2_rain, m2_sol - - real :: allmax -!+---+-----------------------------------------------------------------+ -!For 3D reflectivity calculations - REAL, DIMENSION(ktop:kbot):: qv1d, t1d, p1d, qr1d, qs1d, qg1d, dBZ -!+---+-----------------------------------------------------------------+ - - is = 1 - js = 1 - ks = 1 - ie = iie - iis + 1 - je = jje - jjs + 1 - ke = kke - kks + 1 - ! call mpp_clock_begin (gfdl_mp_clock) - - ! ----------------------------------------------------------------------- - ! define heat capacity of dry air and water vapor based on hydrostatical property - ! ----------------------------------------------------------------------- - - if (phys_hydrostatic .or. hydrostatic) then - c_air = cp_air - c_vap = cp_vap - p_nonhydro = .false. - else - c_air = cv_air - c_vap = cv_vap - p_nonhydro = .true. - endif - d0_vap = c_vap - c_liq - lv00 = hlv0 - d0_vap * t_ice - - if (hydrostatic) do_sedi_w = .false. - - ! ----------------------------------------------------------------------- - ! define latent heat coefficient used in wet bulb and bigg mechanism - ! ----------------------------------------------------------------------- - - latv = hlv - lati = hlf - lats = latv + lati - lat2 = lats * lats - - lcp = latv / cp_air - icp = lati / cp_air - tcp = (latv + lati) / cp_air - - ! tendency zero out for am moist processes should be done outside the driver - - ! ----------------------------------------------------------------------- - ! define cloud microphysics sub time step - ! ----------------------------------------------------------------------- - - mpdt = min (dt_in, mp_time) - rdt = 1. / dt_in - ntimes = nint (dt_in / mpdt) - - ! small time step: - dts = dt_in / real (ntimes) - - ! call get_time (time, seconds, days) - - ! ----------------------------------------------------------------------- - ! initialize precipitation - ! ----------------------------------------------------------------------- - - do j = js, je - do i = is, ie - graupel (i, j) = 0. - rain (i, j) = 0. - snow (i, j) = 0. - ice (i, j) = 0. - cond (i, j) = 0. - enddo - enddo - - ! ----------------------------------------------------------------------- - ! major cloud microphysics - ! ----------------------------------------------------------------------- - - do j = js, je - call mpdrv (hydrostatic, uin, vin, w, delp, pt, qv, ql, qr, qi, qs, qg,& - qa, qn, dz, is, ie, js, je, ks, ke, ktop, kbot, j, dt_in, ntimes, & - rain (:, j), snow (:, j), graupel (:, j), ice (:, j), m2_rain, & - m2_sol, cond (:, j), area (:, j), land (:, j), udt, vdt, pt_dt, & - qv_dt, ql_dt, qr_dt, qi_dt, qs_dt, qg_dt, qa_dt, w_var, vt_r, & - vt_s, vt_g, vt_i, qn2) - enddo - - ! ----------------------------------------------------------------------- - ! no clouds allowed above ktop - ! ----------------------------------------------------------------------- - - if (ks < ktop) then - do k = ks, ktop - if (do_qa) then - do j = js, je - do i = is, ie - qa_dt (i, j, k) = 0. - enddo - enddo - else - do j = js, je - do i = is, ie - ! qa_dt (i, j, k) = - qa (i, j, k) * rdt - qa_dt (i, j, k) = 0. ! gfs - enddo - enddo - endif - enddo - endif - - ! ----------------------------------------------------------------------- - ! diagnostic output - ! ----------------------------------------------------------------------- - - ! if (id_vtr > 0) then - ! used = send_data (id_vtr, vt_r, time, is_in = iis, js_in = jjs) - ! endif - - ! if (id_vts > 0) then - ! used = send_data (id_vts, vt_s, time, is_in = iis, js_in = jjs) - ! endif - - ! if (id_vtg > 0) then - ! used = send_data (id_vtg, vt_g, time, is_in = iis, js_in = jjs) - ! endif - - ! if (id_vti > 0) then - ! used = send_data (id_vti, vt_i, time, is_in = iis, js_in = jjs) - ! endif - - ! if (id_droplets > 0) then - ! used = send_data (id_droplets, qn2, time, is_in = iis, js_in = jjs) - ! endif - - ! if (id_var > 0) then - ! used = send_data (id_var, w_var, time, is_in = iis, js_in = jjs) - ! endif - - ! convert to mm / day - - convt = 86400. * rdt * rgrav - do j = js, je - do i = is, ie - rain (i, j) = rain (i, j) * convt - snow (i, j) = snow (i, j) * convt - ice (i, j) = ice (i, j) * convt - graupel (i, j) = graupel (i, j) * convt - prec_mp (i, j) = rain (i, j) + snow (i, j) + ice (i, j) + graupel (i, j) - enddo - enddo - - ! if (id_cond > 0) then - ! do j = js, je - ! do i = is, ie - ! cond (i, j) = cond (i, j) * rgrav - ! enddo - ! enddo - ! used = send_data (id_cond, cond, time, is_in = iis, js_in = jjs) - ! endif - - ! if (id_snow > 0) then - ! used = send_data (id_snow, snow, time, iis, jjs) - ! used = send_data (id_snow, snow, time, is_in = iis, js_in = jjs) - ! if (mp_print .and. seconds == 0) then - ! tot_prec = g_sum (snow, is, ie, js, je, area, 1) - ! if (master) write (*, *) 'mean snow = ', tot_prec - ! endif - ! endif - ! - ! if (id_graupel > 0) then - ! used = send_data (id_graupel, graupel, time, iis, jjs) - ! used = send_data (id_graupel, graupel, time, is_in = iis, js_in = jjs) - ! if (mp_print .and. seconds == 0) then - ! tot_prec = g_sum (graupel, is, ie, js, je, area, 1) - ! if (master) write (*, *) 'mean graupel = ', tot_prec - ! endif - ! endif - ! - ! if (id_ice > 0) then - ! used = send_data (id_ice, ice, time, iis, jjs) - ! used = send_data (id_ice, ice, time, is_in = iis, js_in = jjs) - ! if (mp_print .and. seconds == 0) then - ! tot_prec = g_sum (ice, is, ie, js, je, area, 1) - ! if (master) write (*, *) 'mean ice_mp = ', tot_prec - ! endif - ! endif - ! - ! if (id_rain > 0) then - ! used = send_data (id_rain, rain, time, iis, jjs) - ! used = send_data (id_rain, rain, time, is_in = iis, js_in = jjs) - ! if (mp_print .and. seconds == 0) then - ! tot_prec = g_sum (rain, is, ie, js, je, area, 1) - ! if (master) write (*, *) 'mean rain = ', tot_prec - ! endif - ! endif - ! - ! if (id_rh > 0) then !not used? - ! used = send_data (id_rh, rh0, time, iis, jjs) - ! used = send_data (id_rh, rh0, time, is_in = iis, js_in = jjs) - ! endif - ! - ! - ! if (id_prec > 0) then - ! used = send_data (id_prec, prec_mp, time, iis, jjs) - ! used = send_data (id_prec, prec_mp, time, is_in = iis, js_in = jjs) - ! endif - - ! if (mp_print) then - ! prec1 (:, :) = prec1 (:, :) + prec_mp (:, :) - ! if (seconds == 0) then - ! prec1 (:, :) = prec1 (:, :) * dt_in / 86400. - ! tot_prec = g_sum (prec1, is, ie, js, je, area, 1) - ! if (master) write (*, *) 'daily prec_mp = ', tot_prec - ! prec1 (:, :) = 0. - ! endif - ! endif - - ! call mpp_clock_end (gfdl_mp_clock) - if(lradar) then - ! Only set melti to true at the output times - if (reset) then - melti = .true. - else - melti = .false. - endif - do j = js, je - do i = is, ie - do k = ktop,kbot - kflip = kbot-ktop+1-k+1 - t1d(k) = pt(i,j,kflip) - p1d(k) = p(i,j,kflip) - qv1d(k) = qv(i,j,kflip)/(1-qv(i,j,kflip)) - qr1d(k) = qr(i,j,kflip) - qs1d(k) = qs(i,j,kflip) - qg1d(k) = qg(i,j,kflip) - enddo - call refl10cm_gfdl (qv1d, qr1d, qs1d, qg1d, & - t1d, p1d, dBZ, ktop, kbot, i,j, melti) - do k = ktop,kbot - kflip = kbot-ktop+1-k+1 - refl_10cm(i,j,kflip) = MAX(-35., dBZ(k)) - enddo - enddo - enddo - endif - - -end subroutine gfdl_cloud_microphys_driver - -! ----------------------------------------------------------------------- -!>@brief gfdl cloud microphysics, major program -!>@details lin et al., 1983, jam, 1065 - 1092, and -!! rutledge and hobbs, 1984, jas, 2949 - 2972 -!! terminal fall is handled lagrangianly by conservative fv algorithm -!>@param pt: temperature (k) -!>@param 6 water species: -!>@param 1) qv: water vapor (kg / kg) -!>@param 2) ql: cloud water (kg / kg) -!>@param 3) qr: rain (kg / kg) -!>@param 4) qi: cloud ice (kg / kg) -!>@param 5) qs: snow (kg / kg) -!>@param 6) qg: graupel (kg / kg) -! ----------------------------------------------------------------------- -subroutine mpdrv (hydrostatic, uin, vin, w, delp, pt, qv, ql, qr, qi, qs, & - qg, qa, qn, dz, is, ie, js, je, ks, ke, ktop, kbot, j, dt_in, ntimes, & - rain, snow, graupel, ice, m2_rain, m2_sol, cond, area1, land, & - u_dt, v_dt, pt_dt, qv_dt, ql_dt, qr_dt, qi_dt, qs_dt, qg_dt, qa_dt, & - w_var, vt_r, vt_s, vt_g, vt_i, qn2) - - implicit none - - logical, intent (in) :: hydrostatic - - integer, intent (in) :: j, is, ie, js, je, ks, ke - integer, intent (in) :: ntimes, ktop, kbot - - real, intent (in) :: dt_in - - real, intent (in), dimension (is:) :: area1, land - - real, intent (in), dimension (is:, js:, ks:) :: uin, vin, delp, pt, dz - real, intent (in), dimension (is:, js:, ks:) :: qv, ql, qr, qg, qa, qn - - real, intent (inout), dimension (is:, js:, ks:) :: qi, qs - real, intent (inout), dimension (is:, js:, ks:) :: u_dt, v_dt, w, pt_dt, qa_dt - real, intent (inout), dimension (is:, js:, ks:) :: qv_dt, ql_dt, qr_dt, qi_dt, qs_dt, qg_dt - - real, intent (inout), dimension (is:) :: rain, snow, ice, graupel, cond - - real, intent (out), dimension (is:, js:) :: w_var - - real, intent (out), dimension (is:, js:, ks:) :: vt_r, vt_s, vt_g, vt_i, qn2 - - real, intent (out), dimension (is:, ks:) :: m2_rain, m2_sol - - real, dimension (ktop:kbot) :: qvz, qlz, qrz, qiz, qsz, qgz, qaz - real, dimension (ktop:kbot) :: vtiz, vtsz, vtgz, vtrz - real, dimension (ktop:kbot) :: dp0, dp1, dz0, dz1 - real, dimension (ktop:kbot) :: qv0, ql0, qr0, qi0, qs0, qg0, qa0 - real, dimension (ktop:kbot) :: t0, den, den0, tz, p1, denfac - real, dimension (ktop:kbot) :: ccn, c_praut, m1_rain, m1_sol, m1 - real, dimension (ktop:kbot) :: u0, v0, u1, v1, w1 - - real :: cpaut, rh_adj, rh_rain - real :: r1, s1, i1, g1, rdt, ccn0 - real :: dt_rain, dts - real :: s_leng, t_land, t_ocean, h_var - real :: cvm, tmp, omq - real :: dqi, qio, qin - - integer :: i, k, n - - dts = dt_in / real (ntimes) - dt_rain = dts * 0.5 - rdt = 1. / dt_in - - ! ----------------------------------------------------------------------- - ! use local variables - ! ----------------------------------------------------------------------- - - do i = is, ie - - do k = ktop, kbot - qiz (k) = qi (i, j, k) - qsz (k) = qs (i, j, k) - enddo - - ! ----------------------------------------------------------------------- - ! this is to prevent excessive build - up of cloud ice from external sources - ! ----------------------------------------------------------------------- - - if (de_ice) then - do k = ktop, kbot - qio = qiz (k) - dt_in * qi_dt (i, j, k) ! original qi before phys - qin = max (qio, qi0_max) ! adjusted value - if (qiz (k) > qin) then - qsz (k) = qsz (k) + qiz (k) - qin - qiz (k) = qin - dqi = (qin - qio) * rdt ! modified qi tendency - qs_dt (i, j, k) = qs_dt (i, j, k) + qi_dt (i, j, k) - dqi - qi_dt (i, j, k) = dqi - qi (i, j, k) = qiz (k) - qs (i, j, k) = qsz (k) - endif - enddo - endif - - do k = ktop, kbot - - t0 (k) = pt (i, j, k) - tz (k) = t0 (k) - dp1 (k) = delp (i, j, k) - dp0 (k) = dp1 (k) ! moist air mass * grav - - ! ----------------------------------------------------------------------- - ! convert moist mixing ratios to dry mixing ratios - ! ----------------------------------------------------------------------- - - qvz (k) = qv (i, j, k) - qlz (k) = ql (i, j, k) - qrz (k) = qr (i, j, k) - qgz (k) = qg (i, j, k) - - ! dp1: dry air_mass - ! dp1 (k) = dp1 (k) * (1. - (qvz (k) + qlz (k) + qrz (k) + qiz (k) + qsz (k) + qgz (k))) - dp1 (k) = dp1 (k) * (1. - qvz (k)) ! gfs - omq = dp0 (k) / dp1 (k) - - qvz (k) = qvz (k) * omq - qlz (k) = qlz (k) * omq - qrz (k) = qrz (k) * omq - qiz (k) = qiz (k) * omq - qsz (k) = qsz (k) * omq - qgz (k) = qgz (k) * omq - - qa0 (k) = qa (i, j, k) - qaz (k) = 0. - dz0 (k) = dz (i, j, k) - - den0 (k) = - dp1 (k) / (grav * dz0 (k)) ! density of dry air - p1 (k) = den0 (k) * rdgas * t0 (k) ! dry air pressure - - ! ----------------------------------------------------------------------- - ! save a copy of old value for computing tendencies - ! ----------------------------------------------------------------------- - - qv0 (k) = qvz (k) - ql0 (k) = qlz (k) - qr0 (k) = qrz (k) - qi0 (k) = qiz (k) - qs0 (k) = qsz (k) - qg0 (k) = qgz (k) - - ! ----------------------------------------------------------------------- - ! for sedi_momentum - ! ----------------------------------------------------------------------- - - m1 (k) = 0. - u0 (k) = uin (i, j, k) - v0 (k) = vin (i, j, k) - u1 (k) = u0 (k) - v1 (k) = v0 (k) - - enddo - - if (do_sedi_w) then - do k = ktop, kbot - w1 (k) = w (i, j, k) - enddo - endif - - ! ----------------------------------------------------------------------- - ! calculate cloud condensation nuclei (ccn) - ! the following is based on klein eq. 15 - ! ----------------------------------------------------------------------- - - cpaut = c_paut * 0.104 * grav / 1.717e-5 - - if (prog_ccn) then - do k = ktop, kbot - ! convert # / cc to # / m^3 - ccn (k) = qn (i, j, k) * 1.e6 - c_praut (k) = cpaut * (ccn (k) * rhor) ** (- 1. / 3.) - enddo - use_ccn = .false. - else - ccn0 = (ccn_l * land (i) + ccn_o * (1. - land (i))) * 1.e6 - if (use_ccn) then - ! ----------------------------------------------------------------------- - ! ccn is formulted as ccn = ccn_surface * (den / den_surface) - ! ----------------------------------------------------------------------- - ccn0 = ccn0 * rdgas * tz (kbot) / p1 (kbot) - endif - tmp = cpaut * (ccn0 * rhor) ** (- 1. / 3.) - do k = ktop, kbot - c_praut (k) = tmp - ccn (k) = ccn0 - enddo - endif - - ! ----------------------------------------------------------------------- - ! calculate horizontal subgrid variability - ! total water subgrid deviation in horizontal direction - ! default area dependent form: use dx ~ 100 km as the base - ! ----------------------------------------------------------------------- - - s_leng = sqrt (sqrt (area1 (i) / 1.e10)) - t_land = dw_land * s_leng - t_ocean = dw_ocean * s_leng - h_var = t_land * land (i) + t_ocean * (1. - land (i)) - h_var = min (0.20, max (0.01, h_var)) - ! if (id_var > 0) w_var (i, j) = h_var - - ! ----------------------------------------------------------------------- - ! relative humidity increment - ! ----------------------------------------------------------------------- - - rh_adj = 1. - h_var - rh_inc - rh_rain = max (0.35, rh_adj - rh_inr) ! rh_inr = 0.25 - - ! ----------------------------------------------------------------------- - ! fix all negative water species - ! ----------------------------------------------------------------------- - - if (fix_negative) & - call neg_adj (ktop, kbot, tz, dp1, qvz, qlz, qrz, qiz, qsz, qgz) - - m2_rain (i, :) = 0. - m2_sol (i, :) = 0. - - do n = 1, ntimes - - ! ----------------------------------------------------------------------- - ! define air density based on hydrostatical property - ! ----------------------------------------------------------------------- - - if (p_nonhydro) then - do k = ktop, kbot - dz1 (k) = dz0 (k) - den (k) = den0 (k) ! dry air density remains the same - denfac (k) = sqrt (sfcrho / den (k)) - enddo - else - do k = ktop, kbot - dz1 (k) = dz0 (k) * tz (k) / t0 (k) ! hydrostatic balance - den (k) = den0 (k) * dz0 (k) / dz1 (k) - denfac (k) = sqrt (sfcrho / den (k)) - enddo - endif - - ! ----------------------------------------------------------------------- - ! time - split warm rain processes: 1st pass - ! ----------------------------------------------------------------------- - - call warm_rain (dt_rain, ktop, kbot, dp1, dz1, tz, qvz, qlz, qrz, qiz, qsz, & - qgz, den, denfac, ccn, c_praut, rh_rain, vtrz, r1, m1_rain, w1, h_var) - - rain (i) = rain (i) + r1 - - do k = ktop, kbot - m2_rain (i, k) = m2_rain (i, k) + m1_rain (k) - m1 (k) = m1 (k) + m1_rain (k) - enddo - - ! ----------------------------------------------------------------------- - ! sedimentation of cloud ice, snow, and graupel - ! ----------------------------------------------------------------------- - - call fall_speed (ktop, kbot, den, qsz, qiz, qgz, qlz, tz, vtsz, vtiz, vtgz) - - call terminal_fall (dts, ktop, kbot, tz, qvz, qlz, qrz, qgz, qsz, qiz, & - dz1, dp1, den, vtgz, vtsz, vtiz, r1, g1, s1, i1, m1_sol, w1) - - rain (i) = rain (i) + r1 ! from melted snow & ice that reached the ground - snow (i) = snow (i) + s1 - graupel (i) = graupel (i) + g1 - ice (i) = ice (i) + i1 - - ! ----------------------------------------------------------------------- - ! heat transportation during sedimentation - ! ----------------------------------------------------------------------- - - if (do_sedi_heat) & - call sedi_heat (ktop, kbot, dp1, m1_sol, dz1, tz, qvz, qlz, qrz, qiz, & - qsz, qgz, c_ice) - - ! ----------------------------------------------------------------------- - ! time - split warm rain processes: 2nd pass - ! ----------------------------------------------------------------------- - - call warm_rain (dt_rain, ktop, kbot, dp1, dz1, tz, qvz, qlz, qrz, qiz, qsz, & - qgz, den, denfac, ccn, c_praut, rh_rain, vtrz, r1, m1_rain, w1, h_var) - - rain (i) = rain (i) + r1 - - do k = ktop, kbot - m2_rain (i, k) = m2_rain (i, k) + m1_rain (k) - m2_sol (i, k) = m2_sol (i, k) + m1_sol (k) - m1 (k) = m1 (k) + m1_rain (k) + m1_sol (k) - enddo - - ! ----------------------------------------------------------------------- - ! ice - phase microphysics - ! ----------------------------------------------------------------------- - - call icloud (ktop, kbot, tz, p1, qvz, qlz, qrz, qiz, qsz, qgz, dp1, den, & - denfac, vtsz, vtgz, vtrz, qaz, rh_adj, rh_rain, dts, h_var) - - enddo - - ! convert units from Pa*kg/kg to kg/m^2/s - m2_rain (i, :) = m2_rain (i, :) * rdt * rgrav - m2_sol (i, :) = m2_sol (i, :) * rdt * rgrav - - ! ----------------------------------------------------------------------- - ! momentum transportation during sedimentation - ! note: dp1 is dry mass; dp0 is the old moist (total) mass - ! ----------------------------------------------------------------------- - - if (sedi_transport) then - do k = ktop + 1, kbot - u1 (k) = (dp0 (k) * u1 (k) + m1 (k - 1) * u1 (k - 1)) / (dp0 (k) + m1 (k - 1)) - v1 (k) = (dp0 (k) * v1 (k) + m1 (k - 1) * v1 (k - 1)) / (dp0 (k) + m1 (k - 1)) - u_dt (i, j, k) = u_dt (i, j, k) + (u1 (k) - u0 (k)) * rdt - v_dt (i, j, k) = v_dt (i, j, k) + (v1 (k) - v0 (k)) * rdt - enddo - endif - - if (do_sedi_w) then - do k = ktop, kbot - w (i, j, k) = w1 (k) - enddo - endif - - ! ----------------------------------------------------------------------- - ! update moist air mass (actually hydrostatic pressure) - ! convert to dry mixing ratios - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - omq = dp1 (k) / dp0 (k) - qv_dt (i, j, k) = qv_dt (i, j, k) + rdt * (qvz (k) - qv0 (k)) * omq - ql_dt (i, j, k) = ql_dt (i, j, k) + rdt * (qlz (k) - ql0 (k)) * omq - qr_dt (i, j, k) = qr_dt (i, j, k) + rdt * (qrz (k) - qr0 (k)) * omq - qi_dt (i, j, k) = qi_dt (i, j, k) + rdt * (qiz (k) - qi0 (k)) * omq - qs_dt (i, j, k) = qs_dt (i, j, k) + rdt * (qsz (k) - qs0 (k)) * omq - qg_dt (i, j, k) = qg_dt (i, j, k) + rdt * (qgz (k) - qg0 (k)) * omq - cvm = c_air + qvz (k) * c_vap + (qrz (k) + qlz (k)) * c_liq + (qiz (k) + qsz (k) + qgz (k)) * c_ice - pt_dt (i, j, k) = pt_dt (i, j, k) + rdt * (tz (k) - t0 (k)) * cvm / cp_air - enddo - - ! ----------------------------------------------------------------------- - ! update cloud fraction tendency - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - if (do_qa) then - qa_dt (i, j, k) = 0. - else - qa_dt (i, j, k) = qa_dt (i, j, k) + rdt * (qaz (k) / real (ntimes) - qa0 (k)) - endif - enddo - - ! ----------------------------------------------------------------------- - ! fms diagnostics: - ! ----------------------------------------------------------------------- - - ! if (id_cond > 0) then - ! do k = ktop, kbot ! total condensate - ! cond (i) = cond (i) + dp1 (k) * (qlz (k) + qrz (k) + qsz (k) + qiz (k) + qgz (k)) - ! enddo - ! endif - ! - ! if (id_vtr > 0) then - ! do k = ktop, kbot - ! vt_r (i, j, k) = vtrz (k) - ! enddo - ! endif - ! - ! if (id_vts > 0) then - ! do k = ktop, kbot - ! vt_s (i, j, k) = vtsz (k) - ! enddo - ! endif - ! - ! if (id_vtg > 0) then - ! do k = ktop, kbot - ! vt_g (i, j, k) = vtgz (k) - ! enddo - ! endif - ! - ! if (id_vts > 0) then - ! do k = ktop, kbot - ! vt_i (i, j, k) = vtiz (k) - ! enddo - ! endif - ! - ! if (id_droplets > 0) then - ! do k = ktop, kbot - ! qn2 (i, j, k) = ccn (k) - ! enddo - ! endif - - enddo - -end subroutine mpdrv - -! ----------------------------------------------------------------------- -!> sedimentation of heat -! ----------------------------------------------------------------------- - -subroutine sedi_heat (ktop, kbot, dm, m1, dz, tz, qv, ql, qr, qi, qs, qg, cw) - - implicit none - - ! input q fields are dry mixing ratios, and dm is dry air mass - - integer, intent (in) :: ktop, kbot - - real, intent (in), dimension (ktop:kbot) :: dm, m1, dz, qv, ql, qr, qi, qs, qg - - real, intent (inout), dimension (ktop:kbot) :: tz - - real, intent (in) :: cw ! heat capacity - - real, dimension (ktop:kbot) :: dgz, cvn - - real :: tmp - - integer :: k - - do k = ktop, kbot - dgz (k) = - 0.5 * grav * dz (k) ! > 0 - cvn (k) = dm (k) * (cv_air + qv (k) * cv_vap + (qr (k) + ql (k)) * & - c_liq + (qi (k) + qs (k) + qg (k)) * c_ice) - enddo - - ! ----------------------------------------------------------------------- - ! sjl, july 2014 - ! assumption: the ke in the falling condensates is negligible compared to the potential energy - ! that was unaccounted for. local thermal equilibrium is assumed, and the loss in pe is transformed - ! into internal energy (to heat the whole grid box) - ! backward time - implicit upwind transport scheme: - ! dm here is dry air mass - ! ----------------------------------------------------------------------- - - k = ktop - tmp = cvn (k) + m1 (k) * cw - tz (k) = (tmp * tz (k) + m1 (k) * dgz (k)) / tmp - - ! ----------------------------------------------------------------------- - ! implicit algorithm: can't be vectorized - ! needs an inner i - loop for vectorization - ! ----------------------------------------------------------------------- - - do k = ktop + 1, kbot - tz (k) = ((cvn (k) + cw * (m1 (k) - m1 (k - 1))) * tz (k) + m1 (k - 1) * & - cw * tz (k - 1) + dgz (k) * (m1 (k - 1) + m1 (k))) / (cvn (k) + cw * m1 (k)) - enddo - -end subroutine sedi_heat - -! ----------------------------------------------------------------------- -!> warm rain cloud microphysics -! ----------------------------------------------------------------------- - -subroutine warm_rain (dt, ktop, kbot, dp, dz, tz, qv, ql, qr, qi, qs, qg, & - den, denfac, ccn, c_praut, rh_rain, vtr, r1, m1_rain, w1, h_var) - - implicit none - - integer, intent (in) :: ktop, kbot - - real, intent (in) :: dt !< time step (s) - real, intent (in) :: rh_rain, h_var - - real, intent (in), dimension (ktop:kbot) :: dp, dz, den - real, intent (in), dimension (ktop:kbot) :: denfac, ccn, c_praut - - real, intent (inout), dimension (ktop:kbot) :: tz, vtr - real, intent (inout), dimension (ktop:kbot) :: qv, ql, qr, qi, qs, qg - real, intent (inout), dimension (ktop:kbot) :: m1_rain, w1 - - real, intent (out) :: r1 - - real, parameter :: so3 = 7. / 3. - - real, dimension (ktop:kbot) :: dl, dm - real, dimension (ktop:kbot + 1) :: ze, zt - - real :: sink, dq, qc0, qc - real :: qden - real :: zs = 0. - real :: dt5 - - integer :: k - - ! fall velocity constants: - - real, parameter :: vconr = 2503.23638966667 - real, parameter :: normr = 25132741228.7183 - real, parameter :: thr = 1.e-8 - - logical :: no_fall - - dt5 = 0.5 * dt - - ! ----------------------------------------------------------------------- - ! terminal speed of rain - ! ----------------------------------------------------------------------- - - m1_rain (:) = 0. - - call check_column (ktop, kbot, qr, no_fall) - - if (no_fall) then - vtr (:) = vf_min - r1 = 0. - else - - ! ----------------------------------------------------------------------- - ! fall speed of rain - ! ----------------------------------------------------------------------- - - if (const_vr) then - vtr (:) = vr_fac ! ifs_2016: 4.0 - else - do k = ktop, kbot - qden = qr (k) * den (k) - if (qr (k) < thr) then - vtr (k) = vr_min - else - vtr (k) = vr_fac * vconr * sqrt (min (10., sfcrho / den (k))) * & - exp (0.2 * log (qden / normr)) - vtr (k) = min (vr_max, max (vr_min, vtr (k))) - endif - enddo - endif - - ze (kbot + 1) = zs - do k = kbot, ktop, - 1 - ze (k) = ze (k + 1) - dz (k) ! dz < 0 - enddo - - ! ----------------------------------------------------------------------- - ! evaporation and accretion of rain for the first 1 / 2 time step - ! ----------------------------------------------------------------------- - - ! if (.not. fast_sat_adj) & - call revap_racc (ktop, kbot, dt5, tz, qv, ql, qr, qi, qs, qg, den, denfac, rh_rain, h_var) - - if (do_sedi_w) then - do k = ktop, kbot - dm (k) = dp (k) * (1. + qv (k) + ql (k) + qr (k) + qi (k) + qs (k) + qg (k)) - enddo - endif - - ! ----------------------------------------------------------------------- - ! mass flux induced by falling rain - ! ----------------------------------------------------------------------- - - if (use_ppm) then - zt (ktop) = ze (ktop) - do k = ktop + 1, kbot - zt (k) = ze (k) - dt5 * (vtr (k - 1) + vtr (k)) - enddo - zt (kbot + 1) = zs - dt * vtr (kbot) - - do k = ktop, kbot - if (zt (k + 1) >= zt (k)) zt (k + 1) = zt (k) - dz_min - enddo - call lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, qr, r1, m1_rain, mono_prof) - else - call implicit_fall (dt, ktop, kbot, ze, vtr, dp, qr, r1, m1_rain) - endif - - ! ----------------------------------------------------------------------- - ! vertical velocity transportation during sedimentation - ! ----------------------------------------------------------------------- - - if (do_sedi_w) then - w1 (ktop) = (dm (ktop) * w1 (ktop) + m1_rain (ktop) * vtr (ktop)) / (dm (ktop) - m1_rain (ktop)) - do k = ktop + 1, kbot - w1 (k) = (dm (k) * w1 (k) - m1_rain (k - 1) * vtr (k - 1) + m1_rain (k) * vtr (k)) & - / (dm (k) + m1_rain (k - 1) - m1_rain (k)) - enddo - endif - - ! ----------------------------------------------------------------------- - ! heat transportation during sedimentation - ! ----------------------------------------------------------------------- - - if (do_sedi_heat) & - call sedi_heat (ktop, kbot, dp, m1_rain, dz, tz, qv, ql, qr, qi, qs, qg, c_liq) - - ! ----------------------------------------------------------------------- - ! evaporation and accretion of rain for the remaing 1 / 2 time step - ! ----------------------------------------------------------------------- - - call revap_racc (ktop, kbot, dt5, tz, qv, ql, qr, qi, qs, qg, den, denfac, rh_rain, h_var) - - endif - - ! ----------------------------------------------------------------------- - ! auto - conversion - ! assuming linear subgrid vertical distribution of cloud water - ! following lin et al. 1994, mwr - ! ----------------------------------------------------------------------- - - if (irain_f /= 0) then - - ! ----------------------------------------------------------------------- - ! no subgrid varaibility - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - qc0 = fac_rc * ccn (k) - if (tz (k) > t_wfr) then - if (use_ccn) then - ! ----------------------------------------------------------------------- - ! ccn is formulted as ccn = ccn_surface * (den / den_surface) - ! ----------------------------------------------------------------------- - qc = qc0 - else - qc = qc0 / den (k) - endif - dq = ql (k) - qc - if (dq > 0.) then - sink = min (dq, dt * c_praut (k) * den (k) * exp (so3 * log (ql (k)))) - ql (k) = ql (k) - sink - qr (k) = qr (k) + sink - endif - endif - enddo - - else - - ! ----------------------------------------------------------------------- - ! with subgrid varaibility - ! ----------------------------------------------------------------------- - - call linear_prof (kbot - ktop + 1, ql (ktop), dl (ktop), z_slope_liq, h_var) - - do k = ktop, kbot - qc0 = fac_rc * ccn (k) - if (tz (k) > t_wfr + dt_fr) then - dl (k) = min (max (1.e-6, dl (k)), 0.5 * ql (k)) - ! -------------------------------------------------------------------- - ! as in klein's gfdl am2 stratiform scheme (with subgrid variations) - ! -------------------------------------------------------------------- - if (use_ccn) then - ! -------------------------------------------------------------------- - ! ccn is formulted as ccn = ccn_surface * (den / den_surface) - ! -------------------------------------------------------------------- - qc = qc0 - else - qc = qc0 / den (k) - endif - dq = 0.5 * (ql (k) + dl (k) - qc) - ! -------------------------------------------------------------------- - ! dq = dl if qc == q_minus = ql - dl - ! dq = 0 if qc == q_plus = ql + dl - ! -------------------------------------------------------------------- - if (dq > 0.) then ! q_plus > qc - ! -------------------------------------------------------------------- - ! revised continuous form: linearly decays (with subgrid dl) to zero at qc == ql + dl - ! -------------------------------------------------------------------- - sink = min (1., dq / dl (k)) * dt * c_praut (k) * den (k) * exp (so3 * log (ql (k))) - ql (k) = ql (k) - sink - qr (k) = qr (k) + sink - endif - endif - enddo - endif - -end subroutine warm_rain - -! ----------------------------------------------------------------------- -!> evaporation of rain -! ----------------------------------------------------------------------- - -subroutine revap_racc (ktop, kbot, dt, tz, qv, ql, qr, qi, qs, qg, den, denfac, rh_rain, h_var) - - implicit none - - integer, intent (in) :: ktop, kbot - - real, intent (in) :: dt ! time step (s) - real, intent (in) :: rh_rain, h_var - - real, intent (in), dimension (ktop:kbot) :: den, denfac - - real, intent (inout), dimension (ktop:kbot) :: tz, qv, qr, ql, qi, qs, qg - - real, dimension (ktop:kbot) :: lhl, cvm, q_liq, q_sol, lcpk - - real :: dqv, qsat, dqsdt, evap, t2, qden, q_plus, q_minus, sink - real :: qpz, dq, dqh, tin - - integer :: k - - do k = ktop, kbot - - if (tz (k) > t_wfr .and. qr (k) > qrmin) then - - ! ----------------------------------------------------------------------- - ! define heat capacity and latent heat coefficient - ! ----------------------------------------------------------------------- - - lhl (k) = lv00 + d0_vap * tz (k) - q_liq (k) = ql (k) + qr (k) - q_sol (k) = qi (k) + qs (k) + qg (k) - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - lcpk (k) = lhl (k) / cvm (k) - - tin = tz (k) - lcpk (k) * ql (k) ! presence of clouds suppresses the rain evap - qpz = qv (k) + ql (k) - qsat = wqs2 (tin, den (k), dqsdt) - dqh = max (ql (k), h_var * max (qpz, qcmin)) - dqh = min (dqh, 0.2 * qpz) ! new limiter - dqv = qsat - qv (k) ! use this to prevent super - sat the gird box - q_minus = qpz - dqh - q_plus = qpz + dqh - - ! ----------------------------------------------------------------------- - ! qsat must be > q_minus to activate evaporation - ! qsat must be < q_plus to activate accretion - ! ----------------------------------------------------------------------- - - ! ----------------------------------------------------------------------- - ! rain evaporation - ! ----------------------------------------------------------------------- - - if (dqv > qvmin .and. qsat > q_minus) then - if (qsat > q_plus) then - dq = qsat - qpz - else - ! ----------------------------------------------------------------------- - ! q_minus < qsat < q_plus - ! dq == dqh if qsat == q_minus - ! ----------------------------------------------------------------------- - dq = 0.25 * (q_minus - qsat) ** 2 / dqh - endif - qden = qr (k) * den (k) - t2 = tin * tin - evap = crevp (1) * t2 * dq * (crevp (2) * sqrt (qden) + crevp (3) * & - exp (0.725 * log (qden))) / (crevp (4) * t2 + crevp (5) * qsat * den (k)) - evap = min (qr (k), dt * evap, dqv / (1. + lcpk (k) * dqsdt)) - ! ----------------------------------------------------------------------- - ! alternative minimum evap in dry environmental air - ! sink = min (qr (k), dim (rh_rain * qsat, qv (k)) / (1. + lcpk (k) * dqsdt)) - ! evap = max (evap, sink) - ! ----------------------------------------------------------------------- - qr (k) = qr (k) - evap - qv (k) = qv (k) + evap - q_liq (k) = q_liq (k) - evap - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz (k) = tz (k) - evap * lhl (k) / cvm (k) - endif - - ! ----------------------------------------------------------------------- - ! accretion: pracc - ! ----------------------------------------------------------------------- - - ! if (qr (k) > qrmin .and. ql (k) > 1.e-7 .and. qsat < q_plus) then - if (qr (k) > qrmin .and. ql (k) > 1.e-6 .and. qsat < q_minus) then - sink = dt * denfac (k) * cracw * exp (0.95 * log (qr (k) * den (k))) - sink = sink / (1. + sink) * ql (k) - ql (k) = ql (k) - sink - qr (k) = qr (k) + sink - endif - - endif ! warm - rain - enddo - -end subroutine revap_racc - -! ----------------------------------------------------------------------- -!> definition of vertical subgrid variability -!! used for cloud ice and cloud water autoconversion -!! qi -- > ql & ql -- > qr -!! edges: qe == qbar + / - dm -! ----------------------------------------------------------------------- - -subroutine linear_prof (km, q, dm, z_var, h_var) - - implicit none - - integer, intent (in) :: km - - real, intent (in) :: q (km), h_var - - real, intent (out) :: dm (km) - - logical, intent (in) :: z_var - - real :: dq (km) - - integer :: k - - if (z_var) then - do k = 2, km - dq (k) = 0.5 * (q (k) - q (k - 1)) - enddo - dm (1) = 0. - - ! ----------------------------------------------------------------------- - ! use twice the strength of the positive definiteness limiter (lin et al 1994) - ! ----------------------------------------------------------------------- - - do k = 2, km - 1 - dm (k) = 0.5 * min (abs (dq (k) + dq (k + 1)), 0.5 * q (k)) - if (dq (k) * dq (k + 1) <= 0.) then - if (dq (k) > 0.) then ! local max - dm (k) = min (dm (k), dq (k), - dq (k + 1)) - else - dm (k) = 0. - endif - endif - enddo - dm (km) = 0. - - ! ----------------------------------------------------------------------- - ! impose a presumed background horizontal variability that is proportional to the value itself - ! ----------------------------------------------------------------------- - - do k = 1, km - dm (k) = max (dm (k), qvmin, h_var * q (k)) - enddo - else - do k = 1, km - dm (k) = max (qvmin, h_var * q (k)) - enddo - endif - -end subroutine linear_prof - -! ======================================================================= -!> ice cloud microphysics processes -!! bulk cloud micro - physics; processes splitting -!! with some un - split sub - grouping -!! time implicit (when possible) accretion and autoconversion -!>@author: Shian-Jiann lin, gfdl -! ======================================================================= - -subroutine icloud (ktop, kbot, tzk, p1, qvk, qlk, qrk, qik, qsk, qgk, dp1, & - den, denfac, vts, vtg, vtr, qak, rh_adj, rh_rain, dts, h_var) - - implicit none - - integer, intent (in) :: ktop, kbot - - real, intent (in), dimension (ktop:kbot) :: p1, dp1, den, denfac, vts, vtg, vtr - - real, intent (inout), dimension (ktop:kbot) :: tzk, qvk, qlk, qrk, qik, qsk, qgk, qak - - real, intent (in) :: rh_adj, rh_rain, dts, h_var - - real, dimension (ktop:kbot) :: lcpk, icpk, tcpk, di, lhl, lhi - real, dimension (ktop:kbot) :: cvm, q_liq, q_sol - - real :: rdts, fac_g2v, fac_v2g, fac_i2s, fac_imlt - real :: tz, qv, ql, qr, qi, qs, qg, melt - real :: pracs, psacw, pgacw, psacr, pgacr, pgaci, praci, psaci - real :: pgmlt, psmlt, pgfr, pgaut, psaut, pgsub - real :: tc, tsq, dqs0, qden, qim, qsm - real :: dt5, factor, sink, qi_crt - real :: tmp, qsw, qsi, dqsdt, dq - real :: dtmp, qc, q_plus, q_minus - - integer :: k - - dt5 = 0.5 * dts - - rdts = 1. / dts - - ! ----------------------------------------------------------------------- - ! define conversion scalar / factor - ! ----------------------------------------------------------------------- - - fac_i2s = 1. - exp (- dts / tau_i2s) - fac_g2v = 1. - exp (- dts / tau_g2v) - fac_v2g = 1. - exp (- dts / tau_v2g) - - fac_imlt = 1. - exp (- dt5 / tau_imlt) - - ! ----------------------------------------------------------------------- - ! define heat capacity and latend heat coefficient - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - lhi (k) = li00 + dc_ice * tzk (k) - q_liq (k) = qlk (k) + qrk (k) - q_sol (k) = qik (k) + qsk (k) + qgk (k) - cvm (k) = c_air + qvk (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - icpk (k) = lhi (k) / cvm (k) - enddo - - ! ----------------------------------------------------------------------- - ! sources of cloud ice: pihom, cold rain, and the sat_adj - ! (initiation plus deposition) - ! sources of snow: cold rain, auto conversion + accretion (from cloud ice) - ! sat_adj (deposition; requires pre - existing snow) ; initial snow comes from auto conversion - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - if (tzk (k) > tice .and. qik (k) > qcmin) then - - ! ----------------------------------------------------------------------- - ! pimlt: instant melting of cloud ice - ! ----------------------------------------------------------------------- - - melt = min (qik (k), fac_imlt * (tzk (k) - tice) / icpk (k)) - tmp = min (melt, dim (ql_mlt, qlk (k))) ! max ql amount - qlk (k) = qlk (k) + tmp - qrk (k) = qrk (k) + melt - tmp - qik (k) = qik (k) - melt - q_liq (k) = q_liq (k) + melt - q_sol (k) = q_sol (k) - melt - cvm (k) = c_air + qvk (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tzk (k) = tzk (k) - melt * lhi (k) / cvm (k) - - elseif (tzk (k) < t_wfr .and. qlk (k) > qcmin) then - - ! ----------------------------------------------------------------------- - ! pihom: homogeneous freezing of cloud water into cloud ice - ! this is the 1st occurance of liquid water freezing in the split mp process - ! ----------------------------------------------------------------------- - - dtmp = t_wfr - tzk (k) - factor = min (1., dtmp / dt_fr) - sink = min (qlk (k) * factor, dtmp / icpk (k)) - qi_crt = qi_gen * min (qi_lim, 0.1 * (tice - tzk (k))) / den (k) - tmp = min (sink, dim (qi_crt, qik (k))) - qlk (k) = qlk (k) - sink - qsk (k) = qsk (k) + sink - tmp - qik (k) = qik (k) + tmp - q_liq (k) = q_liq (k) - sink - q_sol (k) = q_sol (k) + sink - cvm (k) = c_air + qvk (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tzk (k) = tzk (k) + sink * lhi (k) / cvm (k) - - endif - enddo - - ! ----------------------------------------------------------------------- - ! vertical subgrid variability - ! ----------------------------------------------------------------------- - - call linear_prof (kbot - ktop + 1, qik (ktop), di (ktop), z_slope_ice, h_var) - - ! ----------------------------------------------------------------------- - ! update capacity heat and latend heat coefficient - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - lhl (k) = lv00 + d0_vap * tzk (k) - lhi (k) = li00 + dc_ice * tzk (k) - lcpk (k) = lhl (k) / cvm (k) - icpk (k) = lhi (k) / cvm (k) - tcpk (k) = lcpk (k) + icpk (k) - enddo - - do k = ktop, kbot - - ! ----------------------------------------------------------------------- - ! do nothing above p_min - ! ----------------------------------------------------------------------- - - if (p1 (k) < p_min) cycle - - tz = tzk (k) - qv = qvk (k) - ql = qlk (k) - qi = qik (k) - qr = qrk (k) - qs = qsk (k) - qg = qgk (k) - - pgacr = 0. - pgacw = 0. - tc = tz - tice - - if (tc .ge. 0.) then - - ! ----------------------------------------------------------------------- - ! melting of snow - ! ----------------------------------------------------------------------- - - dqs0 = ces0 / p1 (k) - qv - - if (qs > qcmin) then - - ! ----------------------------------------------------------------------- - ! psacw: accretion of cloud water by snow - ! only rate is used (for snow melt) since tc > 0. - ! ----------------------------------------------------------------------- - - if (ql > qrmin) then - factor = denfac (k) * csacw * exp (0.8125 * log (qs * den (k))) - psacw = factor / (1. + dts * factor) * ql ! rate - else - psacw = 0. - endif - - ! ----------------------------------------------------------------------- - ! psacr: accretion of rain by melted snow - ! pracs: accretion of snow by rain - ! ----------------------------------------------------------------------- - - if (qr > qrmin) then - psacr = min (acr3d (vts (k), vtr (k), qr, qs, csacr, acco (1, 2), & - den (k)), qr * rdts) - pracs = acr3d (vtr (k), vts (k), qs, qr, cracs, acco (1, 1), den (k)) - else - psacr = 0. - pracs = 0. - endif - - ! ----------------------------------------------------------------------- - ! total snow sink: - ! psmlt: snow melt (due to rain accretion) - ! ----------------------------------------------------------------------- - - psmlt = max (0., smlt (tc, dqs0, qs * den (k), psacw, psacr, csmlt, & - den (k), denfac (k))) - sink = min (qs, dts * (psmlt + pracs), tc / icpk (k)) - qs = qs - sink - ! sjl, 20170321: - tmp = min (sink, dim (qs_mlt, ql)) ! max ql due to snow melt - ql = ql + tmp - qr = qr + sink - tmp - ! qr = qr + sink - ! sjl, 20170321: - q_liq (k) = q_liq (k) + sink - q_sol (k) = q_sol (k) - sink - cvm (k) = c_air + qv * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz = tz - sink * lhi (k) / cvm (k) - tc = tz - tice - - endif - - ! ----------------------------------------------------------------------- - ! update capacity heat and latend heat coefficient - ! ----------------------------------------------------------------------- - - lhi (k) = li00 + dc_ice * tz - icpk (k) = lhi (k) / cvm (k) - - ! ----------------------------------------------------------------------- - ! melting of graupel - ! ----------------------------------------------------------------------- - - if (qg > qcmin .and. tc > 0.) then - - ! ----------------------------------------------------------------------- - ! pgacr: accretion of rain by graupel - ! ----------------------------------------------------------------------- - - if (qr > qrmin) & - pgacr = min (acr3d (vtg (k), vtr (k), qr, qg, cgacr, acco (1, 3), & - den (k)), rdts * qr) - - ! ----------------------------------------------------------------------- - ! pgacw: accretion of cloud water by graupel - ! ----------------------------------------------------------------------- - - qden = qg * den (k) - if (ql > qrmin) then - factor = cgacw * qden / sqrt (den (k) * sqrt (sqrt (qden))) - pgacw = factor / (1. + dts * factor) * ql ! rate - endif - - ! ----------------------------------------------------------------------- - ! pgmlt: graupel melt - ! ----------------------------------------------------------------------- - - pgmlt = dts * gmlt (tc, dqs0, qden, pgacw, pgacr, cgmlt, den (k)) - pgmlt = min (max (0., pgmlt), qg, tc / icpk (k)) - qg = qg - pgmlt - qr = qr + pgmlt - q_liq (k) = q_liq (k) + pgmlt - q_sol (k) = q_sol (k) - pgmlt - cvm (k) = c_air + qv * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz = tz - pgmlt * lhi (k) / cvm (k) - - endif - - else - - ! ----------------------------------------------------------------------- - ! cloud ice proc: - ! ----------------------------------------------------------------------- - - ! ----------------------------------------------------------------------- - ! psaci: accretion of cloud ice by snow - ! ----------------------------------------------------------------------- - - if (qi > 3.e-7) then ! cloud ice sink terms - - if (qs > 1.e-7) then - ! ----------------------------------------------------------------------- - ! sjl added (following lin eq. 23) the temperature dependency - ! to reduce accretion, use esi = exp (0.05 * tc) as in hong et al 2004 - ! ----------------------------------------------------------------------- - factor = dts * denfac (k) * csaci * exp (0.05 * tc + 0.8125 * log (qs * den (k))) - psaci = factor / (1. + factor) * qi - else - psaci = 0. - endif - - ! ----------------------------------------------------------------------- - ! pasut: autoconversion: cloud ice -- > snow - ! ----------------------------------------------------------------------- - - ! ----------------------------------------------------------------------- - ! similar to lfo 1983: eq. 21 solved implicitly - ! threshold from wsm6 scheme, hong et al 2004, eq (13) : qi0_crt ~0.8e-4 - ! ----------------------------------------------------------------------- - - qim = qi0_crt / den (k) - - ! ----------------------------------------------------------------------- - ! assuming linear subgrid vertical distribution of cloud ice - ! the mismatch computation following lin et al. 1994, mwr - ! ----------------------------------------------------------------------- - - if (const_vi) then - tmp = fac_i2s - else - tmp = fac_i2s * exp (0.025 * tc) - endif - - di (k) = max (di (k), qrmin) - q_plus = qi + di (k) - if (q_plus > (qim + qrmin)) then - if (qim > (qi - di (k))) then - dq = (0.25 * (q_plus - qim) ** 2) / di (k) - else - dq = qi - qim - endif - psaut = tmp * dq - else - psaut = 0. - endif - ! ----------------------------------------------------------------------- - ! sink is no greater than 75% of qi - ! ----------------------------------------------------------------------- - sink = min (0.75 * qi, psaci + psaut) - qi = qi - sink - qs = qs + sink - - ! ----------------------------------------------------------------------- - ! pgaci: accretion of cloud ice by graupel - ! ----------------------------------------------------------------------- - - if (qg > 1.e-6) then - ! ----------------------------------------------------------------------- - ! factor = dts * cgaci / sqrt (den (k)) * exp (0.05 * tc + 0.875 * log (qg * den (k))) - ! simplified form: remove temp dependency & set the exponent "0.875" -- > 1 - ! ----------------------------------------------------------------------- - factor = dts * cgaci * sqrt (den (k)) * qg - pgaci = factor / (1. + factor) * qi - qi = qi - pgaci - qg = qg + pgaci - endif - - endif - - ! ----------------------------------------------------------------------- - ! cold - rain proc: - ! ----------------------------------------------------------------------- - - ! ----------------------------------------------------------------------- - ! rain to ice, snow, graupel processes: - ! ----------------------------------------------------------------------- - - tc = tz - tice - - if (qr > 1.e-7 .and. tc < 0.) then - - ! ----------------------------------------------------------------------- - ! * sink * terms to qr: psacr + pgfr - ! source terms to qs: psacr - ! source terms to qg: pgfr - ! ----------------------------------------------------------------------- - - ! ----------------------------------------------------------------------- - ! psacr accretion of rain by snow - ! ----------------------------------------------------------------------- - - if (qs > 1.e-7) then ! if snow exists - psacr = dts * acr3d (vts (k), vtr (k), qr, qs, csacr, acco (1, 2), den (k)) - else - psacr = 0. - endif - - ! ----------------------------------------------------------------------- - ! pgfr: rain freezing -- > graupel - ! ----------------------------------------------------------------------- - - pgfr = dts * cgfr (1) / den (k) * (exp (- cgfr (2) * tc) - 1.) * & - exp (1.75 * log (qr * den (k))) - - ! ----------------------------------------------------------------------- - ! total sink to qr - ! ----------------------------------------------------------------------- - - sink = psacr + pgfr - factor = min (sink, qr, - tc / icpk (k)) / max (sink, qrmin) - - psacr = factor * psacr - pgfr = factor * pgfr - - sink = psacr + pgfr - qr = qr - sink - qs = qs + psacr - qg = qg + pgfr - q_liq (k) = q_liq (k) - sink - q_sol (k) = q_sol (k) + sink - cvm (k) = c_air + qv * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz = tz + sink * lhi (k) / cvm (k) - - endif - - ! ----------------------------------------------------------------------- - ! update capacity heat and latend heat coefficient - ! ----------------------------------------------------------------------- - - lhi (k) = li00 + dc_ice * tz - icpk (k) = lhi (k) / cvm (k) - - ! ----------------------------------------------------------------------- - ! graupel production terms: - ! ----------------------------------------------------------------------- - - if (qs > 1.e-7) then - - ! ----------------------------------------------------------------------- - ! accretion: snow -- > graupel - ! ----------------------------------------------------------------------- - - if (qg > qrmin) then - sink = dts * acr3d (vtg (k), vts (k), qs, qg, cgacs, acco (1, 4), den (k)) - else - sink = 0. - endif - - ! ----------------------------------------------------------------------- - ! autoconversion snow -- > graupel - ! ----------------------------------------------------------------------- - - qsm = qs0_crt / den (k) - if (qs > qsm) then - factor = dts * 1.e-3 * exp (0.09 * (tz - tice)) - sink = sink + factor / (1. + factor) * (qs - qsm) - endif - sink = min (qs, sink) - qs = qs - sink - qg = qg + sink - - endif ! snow existed - - if (qg > 1.e-7 .and. tz < tice0) then - - ! ----------------------------------------------------------------------- - ! pgacw: accretion of cloud water by graupel - ! ----------------------------------------------------------------------- - - if (ql > 1.e-6) then - qden = qg * den (k) - factor = dts * cgacw * qden / sqrt (den (k) * sqrt (sqrt (qden))) - pgacw = factor / (1. + factor) * ql - else - pgacw = 0. - endif - - ! ----------------------------------------------------------------------- - ! pgacr: accretion of rain by graupel - ! ----------------------------------------------------------------------- - - if (qr > 1.e-6) then - pgacr = min (dts * acr3d (vtg (k), vtr (k), qr, qg, cgacr, acco (1, 3), & - den (k)), qr) - else - pgacr = 0. - endif - - sink = pgacr + pgacw - factor = min (sink, dim (tice, tz) / icpk (k)) / max (sink, qrmin) - pgacr = factor * pgacr - pgacw = factor * pgacw - - sink = pgacr + pgacw - qg = qg + sink - qr = qr - pgacr - ql = ql - pgacw - q_liq (k) = q_liq (k) - sink - q_sol (k) = q_sol (k) + sink - cvm (k) = c_air + qv * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz = tz + sink * lhi (k) / cvm (k) - - endif - - endif - - tzk (k) = tz - qvk (k) = qv - qlk (k) = ql - qik (k) = qi - qrk (k) = qr - qsk (k) = qs - qgk (k) = qg - - enddo - - ! ----------------------------------------------------------------------- - ! subgrid cloud microphysics - ! ----------------------------------------------------------------------- - - call subgrid_z_proc (ktop, kbot, p1, den, denfac, dts, rh_adj, tzk, qvk, & - qlk, qrk, qik, qsk, qgk, qak, h_var, rh_rain) - -end subroutine icloud - -! ======================================================================= -!>temperature sentive high vertical resolution processes -! ======================================================================= - -subroutine subgrid_z_proc (ktop, kbot, p1, den, denfac, dts, rh_adj, tz, qv, & - ql, qr, qi, qs, qg, qa, h_var, rh_rain) - - implicit none - - integer, intent (in) :: ktop, kbot - - real, intent (in), dimension (ktop:kbot) :: p1, den, denfac - - real, intent (in) :: dts, rh_adj, h_var, rh_rain - - real, intent (inout), dimension (ktop:kbot) :: tz, qv, ql, qr, qi, qs, qg, qa - - real, dimension (ktop:kbot) :: lcpk, icpk, tcpk, tcp3, lhl, lhi - real, dimension (ktop:kbot) :: cvm, q_liq, q_sol, q_cond - - real :: fac_v2l, fac_l2v - - real :: pidep, qi_crt - - ! ----------------------------------------------------------------------- - ! qstar over water may be accurate only down to - 80 deg c with ~10% uncertainty - ! must not be too large to allow psc - ! ----------------------------------------------------------------------- - - real :: rh, rqi, tin, qsw, qsi, qpz, qstar - real :: dqsdt, dwsdt, dq, dq0, factor, tmp - real :: q_plus, q_minus, dt_evap, dt_pisub - real :: evap, sink, tc, pisub, q_adj, dtmp - real :: pssub, pgsub, tsq, qden, fac_g2v, fac_v2g - - integer :: k - - if (fast_sat_adj) then - dt_evap = 0.5 * dts - else - dt_evap = dts - endif - - ! ----------------------------------------------------------------------- - ! define conversion scalar / factor - ! ----------------------------------------------------------------------- - - fac_v2l = 1. - exp (- dt_evap / tau_v2l) - fac_l2v = 1. - exp (- dt_evap / tau_l2v) - - fac_g2v = 1. - exp (- dts / tau_g2v) - fac_v2g = 1. - exp (- dts / tau_v2g) - - ! ----------------------------------------------------------------------- - ! define heat capacity and latend heat coefficient - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - lhl (k) = lv00 + d0_vap * tz (k) - lhi (k) = li00 + dc_ice * tz (k) - q_liq (k) = ql (k) + qr (k) - q_sol (k) = qi (k) + qs (k) + qg (k) - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - lcpk (k) = lhl (k) / cvm (k) - icpk (k) = lhi (k) / cvm (k) - tcpk (k) = lcpk (k) + icpk (k) - tcp3 (k) = lcpk (k) + icpk (k) * min (1., dim (tice, tz (k)) / (tice - t_wfr)) - enddo - - do k = ktop, kbot - - if (p1 (k) < p_min) cycle - - ! ----------------------------------------------------------------------- - ! instant deposit all water vapor to cloud ice when temperature is super low - ! ----------------------------------------------------------------------- - - if (tz (k) < t_min) then - sink = dim (qv (k), 1.e-7) - qv (k) = qv (k) - sink - qi (k) = qi (k) + sink - q_sol (k) = q_sol (k) + sink - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz (k) = tz (k) + sink * (lhl (k) + lhi (k)) / cvm (k) - if (.not. do_qa) qa (k) = qa (k) + 1. ! air fully saturated; 100 % cloud cover - cycle - endif - - ! ----------------------------------------------------------------------- - ! update heat capacity and latend heat coefficient - ! ----------------------------------------------------------------------- - - lhl (k) = lv00 + d0_vap * tz (k) - lhi (k) = li00 + dc_ice * tz (k) - lcpk (k) = lhl (k) / cvm (k) - icpk (k) = lhi (k) / cvm (k) - tcpk (k) = lcpk (k) + icpk (k) - tcp3 (k) = lcpk (k) + icpk (k) * min (1., dim (tice, tz (k)) / (tice - t_wfr)) - - ! ----------------------------------------------------------------------- - ! instant evaporation / sublimation of all clouds if rh < rh_adj -- > cloud free - ! ----------------------------------------------------------------------- - - qpz = qv (k) + ql (k) + qi (k) - tin = tz (k) - (lhl (k) * (ql (k) + qi (k)) + lhi (k) * qi (k)) / (c_air + & - qpz * c_vap + qr (k) * c_liq + (qs (k) + qg (k)) * c_ice) - if (tin > t_sub + 6.) then - rh = qpz / iqs1 (tin, den (k)) - if (rh < rh_adj) then ! qpz / rh_adj < qs - tz (k) = tin - qv (k) = qpz - ql (k) = 0. - qi (k) = 0. - cycle ! cloud free - endif - endif - - ! ----------------------------------------------------------------------- - ! cloud water < -- > vapor adjustment: - ! ----------------------------------------------------------------------- - - qsw = wqs2 (tz (k), den (k), dwsdt) - dq0 = qsw - qv (k) - if (dq0 > 0.) then - ! SJL 20170703 added ql factor to prevent the situation of high ql and low RH - ! factor = min (1., fac_l2v * sqrt (max (0., ql (k)) / 1.e-5) * 10. * dq0 / qsw) - ! factor = fac_l2v - ! factor = 1 - factor = min (1., fac_l2v * (10. * dq0 / qsw)) ! the rh dependent factor = 1 at 90% - evap = min (ql (k), factor * dq0 / (1. + tcp3 (k) * dwsdt)) - else ! condensate all excess vapor into cloud water - ! ----------------------------------------------------------------------- - ! evap = fac_v2l * dq0 / (1. + tcp3 (k) * dwsdt) - ! sjl, 20161108 - ! ----------------------------------------------------------------------- - evap = dq0 / (1. + tcp3 (k) * dwsdt) - endif - qv (k) = qv (k) + evap - ql (k) = ql (k) - evap - q_liq (k) = q_liq (k) - evap - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz (k) = tz (k) - evap * lhl (k) / cvm (k) - - ! ----------------------------------------------------------------------- - ! update heat capacity and latend heat coefficient - ! ----------------------------------------------------------------------- - - lhi (k) = li00 + dc_ice * tz (k) - icpk (k) = lhi (k) / cvm (k) - - ! ----------------------------------------------------------------------- - ! enforce complete freezing below - 48 c - ! ----------------------------------------------------------------------- - - dtmp = t_wfr - tz (k) ! [ - 40, - 48] - if (dtmp > 0. .and. ql (k) > qcmin) then - sink = min (ql (k), ql (k) * dtmp * 0.125, dtmp / icpk (k)) - ql (k) = ql (k) - sink - qi (k) = qi (k) + sink - q_liq (k) = q_liq (k) - sink - q_sol (k) = q_sol (k) + sink - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz (k) = tz (k) + sink * lhi (k) / cvm (k) - endif - - ! ----------------------------------------------------------------------- - ! update heat capacity and latend heat coefficient - ! ----------------------------------------------------------------------- - - lhi (k) = li00 + dc_ice * tz (k) - icpk (k) = lhi (k) / cvm (k) - - ! ----------------------------------------------------------------------- - ! bigg mechanism - ! ----------------------------------------------------------------------- - - if (fast_sat_adj) then - dt_pisub = 0.5 * dts - else - dt_pisub = dts - tc = tice - tz (k) - if (ql (k) > qrmin .and. tc > 0.) then - sink = 3.3333e-10 * dts * (exp (0.66 * tc) - 1.) * den (k) * ql (k) * ql (k) - sink = min (ql (k), tc / icpk (k), sink) - ql (k) = ql (k) - sink - qi (k) = qi (k) + sink - q_liq (k) = q_liq (k) - sink - q_sol (k) = q_sol (k) + sink - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz (k) = tz (k) + sink * lhi (k) / cvm (k) - endif ! significant ql existed - endif - - ! ----------------------------------------------------------------------- - ! update capacity heat and latend heat coefficient - ! ----------------------------------------------------------------------- - - lhl (k) = lv00 + d0_vap * tz (k) - lhi (k) = li00 + dc_ice * tz (k) - lcpk (k) = lhl (k) / cvm (k) - icpk (k) = lhi (k) / cvm (k) - tcpk (k) = lcpk (k) + icpk (k) - - ! ----------------------------------------------------------------------- - ! sublimation / deposition of ice - ! ----------------------------------------------------------------------- - - if (tz (k) < tice) then - qsi = iqs2 (tz (k), den (k), dqsdt) - dq = qv (k) - qsi - sink = dq / (1. + tcpk (k) * dqsdt) - if (qi (k) > qrmin) then - ! eq 9, hong et al. 2004, mwr - ! for a and b, see dudhia 1989: page 3103 eq (b7) and (b8) - pidep = dt_pisub * dq * 349138.78 * exp (0.875 * log (qi (k) * den (k))) & - / (qsi * den (k) * lat2 / (0.0243 * rvgas * tz (k) ** 2) + 4.42478e4) - else - pidep = 0. - endif - if (dq > 0.) then ! vapor - > ice - tmp = tice - tz (k) - ! 20160912: the following should produce more ice at higher altitude - ! qi_crt = 4.92e-11 * exp (1.33 * log (1.e3 * exp (0.1 * tmp))) / den (k) - qi_crt = qi_gen * min (qi_lim, 0.1 * tmp) / den (k) - sink = min (sink, max (qi_crt - qi (k), pidep), tmp / tcpk (k)) - else ! ice -- > vapor - pidep = pidep * min (1., dim (tz (k), t_sub) * 0.2) - sink = max (pidep, sink, - qi (k)) - endif - qv (k) = qv (k) - sink - qi (k) = qi (k) + sink - q_sol (k) = q_sol (k) + sink - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz (k) = tz (k) + sink * (lhl (k) + lhi (k)) / cvm (k) - endif - - ! ----------------------------------------------------------------------- - ! update capacity heat and latend heat coefficient - ! ----------------------------------------------------------------------- - - lhl (k) = lv00 + d0_vap * tz (k) - lhi (k) = li00 + dc_ice * tz (k) - lcpk (k) = lhl (k) / cvm (k) - icpk (k) = lhi (k) / cvm (k) - tcpk (k) = lcpk (k) + icpk (k) - - ! ----------------------------------------------------------------------- - ! sublimation / deposition of snow - ! this process happens for all temp rage - ! ----------------------------------------------------------------------- - - if (qs (k) > qrmin) then - qsi = iqs2 (tz (k), den (k), dqsdt) - qden = qs (k) * den (k) - tmp = exp (0.65625 * log (qden)) - tsq = tz (k) * tz (k) - dq = (qsi - qv (k)) / (1. + tcpk (k) * dqsdt) - pssub = cssub (1) * tsq * (cssub (2) * sqrt (qden) + cssub (3) * tmp * & - sqrt (denfac (k))) / (cssub (4) * tsq + cssub (5) * qsi * den (k)) - pssub = (qsi - qv (k)) * dts * pssub - if (pssub > 0.) then ! qs -- > qv, sublimation - pssub = min (pssub * min (1., dim (tz (k), t_sub) * 0.2), qs (k)) - else - if (tz (k) > tice) then - pssub = 0. ! no deposition - else - pssub = max (pssub, dq, (tz (k) - tice) / tcpk (k)) - endif - endif - qs (k) = qs (k) - pssub - qv (k) = qv (k) + pssub - q_sol (k) = q_sol (k) - pssub - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz (k) = tz (k) - pssub * (lhl (k) + lhi (k)) / cvm (k) - endif - - ! ----------------------------------------------------------------------- - ! update capacity heat and latend heat coefficient - ! ----------------------------------------------------------------------- - - lhl (k) = lv00 + d0_vap * tz (k) - lhi (k) = li00 + dc_ice * tz (k) - lcpk (k) = lhl (k) / cvm (k) - icpk (k) = lhi (k) / cvm (k) - tcpk (k) = lcpk (k) + icpk (k) - - ! ----------------------------------------------------------------------- - ! simplified 2 - way grapuel sublimation - deposition mechanism - ! ----------------------------------------------------------------------- - - if (qg (k) > qrmin) then - qsi = iqs2 (tz (k), den (k), dqsdt) - dq = (qv (k) - qsi) / (1. + tcpk (k) * dqsdt) - pgsub = (qv (k) / qsi - 1.) * qg (k) - if (pgsub > 0.) then ! deposition - if (tz (k) > tice) then - pgsub = 0. ! no deposition - else - pgsub = min (fac_v2g * pgsub, 0.2 * dq, ql (k) + qr (k), & - (tice - tz (k)) / tcpk (k)) - endif - else ! submilation - pgsub = max (fac_g2v * pgsub, dq) * min (1., dim (tz (k), t_sub) * 0.1) - endif - qg (k) = qg (k) + pgsub - qv (k) = qv (k) - pgsub - q_sol (k) = q_sol (k) + pgsub - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz (k) = tz (k) + pgsub * (lhl (k) + lhi (k)) / cvm (k) - endif - -#ifdef USE_MIN_EVAP - ! ----------------------------------------------------------------------- - ! update capacity heat and latend heat coefficient - ! ----------------------------------------------------------------------- - - lhl (k) = lv00 + d0_vap * tz (k) - lcpk (k) = lhl (k) / cvm (k) - - ! ----------------------------------------------------------------------- - ! * minimum evap of rain in dry environmental air - ! ----------------------------------------------------------------------- - - if (qr (k) > qcmin) then - qsw = wqs2 (tz (k), den (k), dqsdt) - sink = min (qr (k), dim (rh_rain * qsw, qv (k)) / (1. + lcpk (k) * dqsdt)) - qv (k) = qv (k) + sink - qr (k) = qr (k) - sink - q_liq (k) = q_liq (k) - sink - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz (k) = tz (k) - sink * lhl (k) / cvm (k) - endif -#endif - - ! ----------------------------------------------------------------------- - ! update capacity heat and latend heat coefficient - ! ----------------------------------------------------------------------- - - lhl (k) = lv00 + d0_vap * tz (k) - cvm (k) = c_air + (qv (k) + q_liq (k) + q_sol (k)) * c_vap - lcpk (k) = lhl (k) / cvm (k) - - ! ----------------------------------------------------------------------- - ! compute cloud fraction - ! ----------------------------------------------------------------------- - - ! ----------------------------------------------------------------------- - ! combine water species - ! ----------------------------------------------------------------------- - - if (do_qa) cycle - - if (rad_snow) then - q_sol (k) = qi (k) + qs (k) - else - q_sol (k) = qi (k) - endif - if (rad_rain) then - q_liq (k) = ql (k) + qr (k) - else - q_liq (k) = ql (k) - endif - q_cond (k) = q_liq (k) + q_sol (k) - - qpz = qv (k) + q_cond (k) ! qpz is conserved - - ! ----------------------------------------------------------------------- - ! use the "liquid - frozen water temperature" (tin) to compute saturated specific humidity - ! ----------------------------------------------------------------------- - - tin = tz (k) - (lcpk (k) * q_cond (k) + icpk (k) * q_sol (k)) ! minimum temperature - ! tin = tz (k) - ((lv00 + d0_vap * tz (k)) * q_cond (k) + & - ! (li00 + dc_ice * tz (k)) * q_sol (k)) / (c_air + qpz * c_vap) - - ! ----------------------------------------------------------------------- - ! determine saturated specific humidity - ! ----------------------------------------------------------------------- - - if (tin <= t_wfr) then - ! ice phase: - qstar = iqs1 (tin, den (k)) - elseif (tin >= tice) then - ! liquid phase: - qstar = wqs1 (tin, den (k)) - else - ! mixed phase: - qsi = iqs1 (tin, den (k)) - qsw = wqs1 (tin, den (k)) - if (q_cond (k) > 3.e-6) then - rqi = q_sol (k) / q_cond (k) - else - ! ----------------------------------------------------------------------- - ! mostly liquid water q_cond (k) at initial cloud development stage - ! ----------------------------------------------------------------------- - rqi = (tice - tin) / (tice - t_wfr) - endif - qstar = rqi * qsi + (1. - rqi) * qsw - endif - - ! ----------------------------------------------------------------------- - ! assuming subgrid linear distribution in horizontal; this is effectively a smoother for the - ! binary cloud scheme - ! ----------------------------------------------------------------------- - - if (qpz > qrmin) then - ! partial cloudiness by pdf: - dq = max (qcmin, h_var * qpz) - q_plus = qpz + dq ! cloud free if qstar > q_plus - q_minus = qpz - dq - if (qstar < q_minus) then - qa (k) = qa (k) + 1. ! air fully saturated; 100 % cloud cover - elseif (qstar < q_plus .and. q_cond (k) > qc_crt) then - qa (k) = qa (k) + (q_plus - qstar) / (dq + dq) ! partial cloud cover - ! qa (k) = sqrt (qa (k) + (q_plus - qstar) / (dq + dq)) - endif - endif - - enddo - -end subroutine subgrid_z_proc - -! ======================================================================= -!> rain evaporation -! ======================================================================= - -subroutine revap_rac1 (hydrostatic, is, ie, dt, tz, qv, ql, qr, qi, qs, qg, den, hvar) - - implicit none - - logical, intent (in) :: hydrostatic - - integer, intent (in) :: is, ie - - real, intent (in) :: dt ! time step (s) - - real, intent (in), dimension (is:ie) :: den, hvar, qi, qs, qg - - real, intent (inout), dimension (is:ie) :: tz, qv, qr, ql - - real, dimension (is:ie) :: lcp2, denfac, q_liq, q_sol, cvm, lhl - - real :: dqv, qsat, dqsdt, evap, qden, q_plus, q_minus, sink - real :: tin, t2, qpz, dq, dqh - - integer :: i - - ! ----------------------------------------------------------------------- - ! define latend heat coefficient - ! ----------------------------------------------------------------------- - - do i = is, ie - lhl (i) = lv00 + d0_vap * tz (i) - q_liq (i) = ql (i) + qr (i) - q_sol (i) = qi (i) + qs (i) + qg (i) - cvm (i) = c_air + qv (i) * c_vap + q_liq (i) * c_liq + q_sol (i) * c_ice - lcp2 (i) = lhl (i) / cvm (i) - ! denfac (i) = sqrt (sfcrho / den (i)) - enddo - - do i = is, ie - if (qr (i) > qrmin .and. tz (i) > t_wfr) then - qpz = qv (i) + ql (i) - tin = tz (i) - lcp2 (i) * ql (i) ! presence of clouds suppresses the rain evap - qsat = wqs2 (tin, den (i), dqsdt) - dqh = max (ql (i), hvar (i) * max (qpz, qcmin)) - dqv = qsat - qv (i) - q_minus = qpz - dqh - q_plus = qpz + dqh - - ! ----------------------------------------------------------------------- - ! qsat must be > q_minus to activate evaporation - ! qsat must be < q_plus to activate accretion - ! ----------------------------------------------------------------------- - - ! ----------------------------------------------------------------------- - ! rain evaporation - ! ----------------------------------------------------------------------- - - if (dqv > qvmin .and. qsat > q_minus) then - if (qsat > q_plus) then - dq = qsat - qpz - else - ! q_minus < qsat < q_plus - ! dq == dqh if qsat == q_minus - dq = 0.25 * (q_minus - qsat) ** 2 / dqh - endif - qden = qr (i) * den (i) - t2 = tin * tin - evap = crevp (1) * t2 * dq * (crevp (2) * sqrt (qden) + crevp (3) * exp (0.725 * log (qden))) & - / (crevp (4) * t2 + crevp (5) * qsat * den (i)) - evap = min (qr (i), dt * evap, dqv / (1. + lcp2 (i) * dqsdt)) - qr (i) = qr (i) - evap - qv (i) = qv (i) + evap - q_liq (i) = q_liq (i) - evap - cvm (i) = c_air + qv (i) * c_vap + q_liq (i) * c_liq + q_sol (i) * c_ice - tz (i) = tz (i) - evap * lhl (i) / cvm (i) - endif - - ! ----------------------------------------------------------------------- - ! accretion: pracc - ! ----------------------------------------------------------------------- - - if (qr (i) > qrmin .and. ql (i) > 1.e-8 .and. qsat < q_plus) then - denfac (i) = sqrt (sfcrho / den (i)) - sink = dt * denfac (i) * cracw * exp (0.95 * log (qr (i) * den (i))) - sink = sink / (1. + sink) * ql (i) - ql (i) = ql (i) - sink - qr (i) = qr (i) + sink - endif - endif - enddo - -end subroutine revap_rac1 - -! ======================================================================= -!>@brief The subroutine 'terminal_fall' computes terminal fall speed. -!>@details It considers cloud ice, snow, and graupel's melting during fall. -! ======================================================================= - -subroutine terminal_fall (dtm, ktop, kbot, tz, qv, ql, qr, qg, qs, qi, dz, dp, & - den, vtg, vts, vti, r1, g1, s1, i1, m1_sol, w1) - - implicit none - - integer, intent (in) :: ktop, kbot - - real, intent (in) :: dtm ! time step (s) - - real, intent (in), dimension (ktop:kbot) :: vtg, vts, vti, den, dp, dz - - real, intent (inout), dimension (ktop:kbot) :: qv, ql, qr, qg, qs, qi, tz, m1_sol, w1 - - real, intent (out) :: r1, g1, s1, i1 - - real, dimension (ktop:kbot + 1) :: ze, zt - - real :: qsat, dqsdt, dt5, evap, dtime - real :: factor, frac - real :: tmp, precip, tc, sink - - real, dimension (ktop:kbot) :: lcpk, icpk, cvm, q_liq, q_sol, lhl, lhi - real, dimension (ktop:kbot) :: m1, dm - - real :: zs = 0. - real :: fac_imlt - - integer :: k, k0, m - - logical :: no_fall - - dt5 = 0.5 * dtm - fac_imlt = 1. - exp (- dt5 / tau_imlt) - - ! ----------------------------------------------------------------------- - ! define heat capacity and latend heat coefficient - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - m1_sol (k) = 0. - lhl (k) = lv00 + d0_vap * tz (k) - lhi (k) = li00 + dc_ice * tz (k) - q_liq (k) = ql (k) + qr (k) - q_sol (k) = qi (k) + qs (k) + qg (k) - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - lcpk (k) = lhl (k) / cvm (k) - icpk (k) = lhi (k) / cvm (k) - enddo - - ! ----------------------------------------------------------------------- - ! find significant melting level - ! ----------------------------------------------------------------------- - - k0 = kbot - do k = ktop, kbot - 1 - if (tz (k) > tice) then - k0 = k - exit - endif - enddo - - ! ----------------------------------------------------------------------- - ! melting of cloud_ice (before fall) : - ! ----------------------------------------------------------------------- - - do k = k0, kbot - tc = tz (k) - tice - if (qi (k) > qcmin .and. tc > 0.) then - sink = min (qi (k), fac_imlt * tc / icpk (k)) - tmp = min (sink, dim (ql_mlt, ql (k))) - ql (k) = ql (k) + tmp - qr (k) = qr (k) + sink - tmp - qi (k) = qi (k) - sink - q_liq (k) = q_liq (k) + sink - q_sol (k) = q_sol (k) - sink - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz (k) = tz (k) - sink * lhi (k) / cvm (k) - tc = tz (k) - tice - endif - enddo - - ! ----------------------------------------------------------------------- - ! turn off melting when cloud microphysics time step is small - ! ----------------------------------------------------------------------- - - if (dtm < 60.) k0 = kbot - - ! sjl, turn off melting of falling cloud ice, snow and graupel - k0 = kbot - ! sjl, turn off melting of falling cloud ice, snow and graupel - - ze (kbot + 1) = zs - do k = kbot, ktop, - 1 - ze (k) = ze (k + 1) - dz (k) ! dz < 0 - enddo - - zt (ktop) = ze (ktop) - - ! ----------------------------------------------------------------------- - ! update capacity heat and latend heat coefficient - ! ----------------------------------------------------------------------- - - do k = k0, kbot - lhi (k) = li00 + dc_ice * tz (k) - icpk (k) = lhi (k) / cvm (k) - enddo - - ! ----------------------------------------------------------------------- - ! melting of falling cloud ice into rain - ! ----------------------------------------------------------------------- - - call check_column (ktop, kbot, qi, no_fall) - - if (vi_fac < 1.e-5 .or. no_fall) then - i1 = 0. - else - - do k = ktop + 1, kbot - zt (k) = ze (k) - dt5 * (vti (k - 1) + vti (k)) - enddo - zt (kbot + 1) = zs - dtm * vti (kbot) - - do k = ktop, kbot - if (zt (k + 1) >= zt (k)) zt (k + 1) = zt (k) - dz_min - enddo - - if (k0 < kbot) then - do k = kbot - 1, k0, - 1 - if (qi (k) > qrmin) then - do m = k + 1, kbot - if (zt (k + 1) >= ze (m)) exit - if (zt (k) < ze (m + 1) .and. tz (m) > tice) then - dtime = min (1.0, (ze (m) - ze (m + 1)) / (max (vr_min, vti (k)) * tau_imlt)) - sink = min (qi (k) * dp (k) / dp (m), dtime * (tz (m) - tice) / icpk (m)) - tmp = min (sink, dim (ql_mlt, ql (m))) - ql (m) = ql (m) + tmp - qr (m) = qr (m) - tmp + sink - tz (m) = tz (m) - sink * icpk (m) - qi (k) = qi (k) - sink * dp (m) / dp (k) - endif - enddo - endif - enddo - endif - - if (do_sedi_w) then - do k = ktop, kbot - dm (k) = dp (k) * (1. + qv (k) + ql (k) + qr (k) + qi (k) + qs (k) + qg (k)) - enddo - endif - - if (use_ppm) then - call lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, qi, i1, m1_sol, mono_prof) - else - call implicit_fall (dtm, ktop, kbot, ze, vti, dp, qi, i1, m1_sol) - endif - - if (do_sedi_w) then - w1 (ktop) = (dm (ktop) * w1 (ktop) + m1_sol (ktop) * vti (ktop)) / (dm (ktop) - m1_sol (ktop)) - do k = ktop + 1, kbot - w1 (k) = (dm (k) * w1 (k) - m1_sol (k - 1) * vti (k - 1) + m1_sol (k) * vti (k)) & - / (dm (k) + m1_sol (k - 1) - m1_sol (k)) - enddo - endif - - endif - - ! ----------------------------------------------------------------------- - ! melting of falling snow into rain - ! ----------------------------------------------------------------------- - - r1 = 0. - - call check_column (ktop, kbot, qs, no_fall) - - if (no_fall) then - s1 = 0. - else - - do k = ktop + 1, kbot - zt (k) = ze (k) - dt5 * (vts (k - 1) + vts (k)) - enddo - zt (kbot + 1) = zs - dtm * vts (kbot) - - do k = ktop, kbot - if (zt (k + 1) >= zt (k)) zt (k + 1) = zt (k) - dz_min - enddo - - if (k0 < kbot) then - do k = kbot - 1, k0, - 1 - if (qs (k) > qrmin) then - do m = k + 1, kbot - if (zt (k + 1) >= ze (m)) exit - dtime = min (dtm, (ze (m) - ze (m + 1)) / (vr_min + vts (k))) - if (zt (k) < ze (m + 1) .and. tz (m) > tice) then - dtime = min (1.0, dtime / tau_smlt) - sink = min (qs (k) * dp (k) / dp (m), dtime * (tz (m) - tice) / icpk (m)) - tz (m) = tz (m) - sink * icpk (m) - qs (k) = qs (k) - sink * dp (m) / dp (k) - if (zt (k) < zs) then - r1 = r1 + sink * dp (m) ! precip as rain - else - ! qr source here will fall next time step (therefore, can evap) - qr (m) = qr (m) + sink - endif - endif - if (qs (k) < qrmin) exit - enddo - endif - enddo - endif - - if (do_sedi_w) then - do k = ktop, kbot - dm (k) = dp (k) * (1. + qv (k) + ql (k) + qr (k) + qi (k) + qs (k) + qg (k)) - enddo - endif - - if (use_ppm) then - call lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, qs, s1, m1, mono_prof) - else - call implicit_fall (dtm, ktop, kbot, ze, vts, dp, qs, s1, m1) - endif - - do k = ktop, kbot - m1_sol (k) = m1_sol (k) + m1 (k) - enddo - - if (do_sedi_w) then - w1 (ktop) = (dm (ktop) * w1 (ktop) + m1 (ktop) * vts (ktop)) / (dm (ktop) - m1 (ktop)) - do k = ktop + 1, kbot - w1 (k) = (dm (k) * w1 (k) - m1 (k - 1) * vts (k - 1) + m1 (k) * vts (k)) & - / (dm (k) + m1 (k - 1) - m1 (k)) - enddo - endif - - endif - - ! ---------------------------------------------- - ! melting of falling graupel into rain - ! ---------------------------------------------- - - call check_column (ktop, kbot, qg, no_fall) - - if (no_fall) then - g1 = 0. - else - - do k = ktop + 1, kbot - zt (k) = ze (k) - dt5 * (vtg (k - 1) + vtg (k)) - enddo - zt (kbot + 1) = zs - dtm * vtg (kbot) - - do k = ktop, kbot - if (zt (k + 1) >= zt (k)) zt (k + 1) = zt (k) - dz_min - enddo - - if (k0 < kbot) then - do k = kbot - 1, k0, - 1 - if (qg (k) > qrmin) then - do m = k + 1, kbot - if (zt (k + 1) >= ze (m)) exit - dtime = min (dtm, (ze (m) - ze (m + 1)) / vtg (k)) - if (zt (k) < ze (m + 1) .and. tz (m) > tice) then - dtime = min (1., dtime / tau_g2r) - sink = min (qg (k) * dp (k) / dp (m), dtime * (tz (m) - tice) / icpk (m)) - tz (m) = tz (m) - sink * icpk (m) - qg (k) = qg (k) - sink * dp (m) / dp (k) - if (zt (k) < zs) then - r1 = r1 + sink * dp (m) - else - qr (m) = qr (m) + sink - endif - endif - if (qg (k) < qrmin) exit - enddo - endif - enddo - endif - - if (do_sedi_w) then - do k = ktop, kbot - dm (k) = dp (k) * (1. + qv (k) + ql (k) + qr (k) + qi (k) + qs (k) + qg (k)) - enddo - endif - - if (use_ppm) then - call lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, qg, g1, m1, mono_prof) - else - call implicit_fall (dtm, ktop, kbot, ze, vtg, dp, qg, g1, m1) - endif - - do k = ktop, kbot - m1_sol (k) = m1_sol (k) + m1 (k) - enddo - - if (do_sedi_w) then - w1 (ktop) = (dm (ktop) * w1 (ktop) + m1 (ktop) * vtg (ktop)) / (dm (ktop) - m1 (ktop)) - do k = ktop + 1, kbot - w1 (k) = (dm (k) * w1 (k) - m1 (k - 1) * vtg (k - 1) + m1 (k) * vtg (k)) & - / (dm (k) + m1 (k - 1) - m1 (k)) - enddo - endif - - endif - -end subroutine terminal_fall - -! ======================================================================= -!>@brief The subroutine 'check_column' checks -!! if the water species is large enough to fall. -! ======================================================================= - -subroutine check_column (ktop, kbot, q, no_fall) - - implicit none - - integer, intent (in) :: ktop, kbot - - real, intent (in) :: q (ktop:kbot) - - logical, intent (out) :: no_fall - - integer :: k - - no_fall = .true. - - do k = ktop, kbot - if (q (k) > qrmin) then - no_fall = .false. - exit - endif - enddo - -end subroutine check_column - -! ======================================================================= -!>@brief The subroutine 'implicit_fall' computes the time-implicit monotonic -!! scheme. -!>@author Shian-Jiann Lin, 2016 -! ======================================================================= - -subroutine implicit_fall (dt, ktop, kbot, ze, vt, dp, q, precip, m1) - - implicit none - - integer, intent (in) :: ktop, kbot - - real, intent (in) :: dt - - real, intent (in), dimension (ktop:kbot + 1) :: ze - - real, intent (in), dimension (ktop:kbot) :: vt, dp - - real, intent (inout), dimension (ktop:kbot) :: q - - real, intent (out), dimension (ktop:kbot) :: m1 - - real, intent (out) :: precip - - real, dimension (ktop:kbot) :: dz, qm, dd - - integer :: k - - do k = ktop, kbot - dz (k) = ze (k) - ze (k + 1) - dd (k) = dt * vt (k) - q (k) = q (k) * dp (k) - enddo - - ! ----------------------------------------------------------------------- - ! sedimentation: non - vectorizable loop - ! ----------------------------------------------------------------------- - - qm (ktop) = q (ktop) / (dz (ktop) + dd (ktop)) - do k = ktop + 1, kbot - qm (k) = (q (k) + dd (k - 1) * qm (k - 1)) / (dz (k) + dd (k)) - enddo - - ! ----------------------------------------------------------------------- - ! qm is density at this stage - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - qm (k) = qm (k) * dz (k) - enddo - - ! ----------------------------------------------------------------------- - ! output mass fluxes: non - vectorizable loop - ! ----------------------------------------------------------------------- - - m1 (ktop) = q (ktop) - qm (ktop) - do k = ktop + 1, kbot - m1 (k) = m1 (k - 1) + q (k) - qm (k) - enddo - precip = m1 (kbot) - - ! ----------------------------------------------------------------------- - ! update: - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - q (k) = qm (k) / dp (k) - enddo - -end subroutine implicit_fall - -! ======================================================================= -!> lagrangian scheme -! developed by sj lin, ???? -! ======================================================================= - -subroutine lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, q, precip, m1, mono) - - implicit none - - integer, intent (in) :: ktop, kbot - - real, intent (in) :: zs - - logical, intent (in) :: mono - - real, intent (in), dimension (ktop:kbot + 1) :: ze, zt - - real, intent (in), dimension (ktop:kbot) :: dp - - ! m1: flux - real, intent (inout), dimension (ktop:kbot) :: q, m1 - - real, intent (out) :: precip - - real, dimension (ktop:kbot) :: qm, dz - - real :: a4 (4, ktop:kbot) - - real :: pl, pr, delz, esl - - integer :: k, k0, n, m - - real, parameter :: r3 = 1. / 3., r23 = 2. / 3. - - ! ----------------------------------------------------------------------- - ! density: - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - dz (k) = zt (k) - zt (k + 1) ! note: dz is positive - q (k) = q (k) * dp (k) - a4 (1, k) = q (k) / dz (k) - qm (k) = 0. - enddo - - ! ----------------------------------------------------------------------- - ! construct vertical profile with zt as coordinate - ! ----------------------------------------------------------------------- - - call cs_profile (a4 (1, ktop), dz (ktop), kbot - ktop + 1, mono) - - k0 = ktop - do k = ktop, kbot - do n = k0, kbot - if (ze (k) <= zt (n) .and. ze (k) >= zt (n + 1)) then - pl = (zt (n) - ze (k)) / dz (n) - if (zt (n + 1) <= ze (k + 1)) then - ! entire new grid is within the original grid - pr = (zt (n) - ze (k + 1)) / dz (n) - qm (k) = a4 (2, n) + 0.5 * (a4 (4, n) + a4 (3, n) - a4 (2, n)) * (pr + pl) - & - a4 (4, n) * r3 * (pr * (pr + pl) + pl ** 2) - qm (k) = qm (k) * (ze (k) - ze (k + 1)) - k0 = n - goto 555 - else - qm (k) = (ze (k) - zt (n + 1)) * (a4 (2, n) + 0.5 * (a4 (4, n) + & - a4 (3, n) - a4 (2, n)) * (1. + pl) - a4 (4, n) * (r3 * (1. + pl * (1. + pl)))) - if (n < kbot) then - do m = n + 1, kbot - ! locate the bottom edge: ze (k + 1) - if (ze (k + 1) < zt (m + 1)) then - qm (k) = qm (k) + q (m) - else - delz = zt (m) - ze (k + 1) - esl = delz / dz (m) - qm (k) = qm (k) + delz * (a4 (2, m) + 0.5 * esl * & - (a4 (3, m) - a4 (2, m) + a4 (4, m) * (1. - r23 * esl))) - k0 = m - goto 555 - endif - enddo - endif - goto 555 - endif - endif - enddo - 555 continue - enddo - - m1 (ktop) = q (ktop) - qm (ktop) - do k = ktop + 1, kbot - m1 (k) = m1 (k - 1) + q (k) - qm (k) - enddo - precip = m1 (kbot) - - ! convert back to * dry * mixing ratio: - ! dp must be dry air_mass (because moist air mass will be changed due to terminal fall) . - - do k = ktop, kbot - q (k) = qm (k) / dp (k) - enddo - -end subroutine lagrangian_fall_ppm - -subroutine cs_profile (a4, del, km, do_mono) - - implicit none - - integer, intent (in) :: km !< vertical dimension - - real, intent (in) :: del (km) - - logical, intent (in) :: do_mono - - real, intent (inout) :: a4 (4, km) - - real, parameter :: qp_min = 1.e-6 - - real :: gam (km) - real :: q (km + 1) - real :: d4, bet, a_bot, grat, pmp, lac - real :: pmp_1, lac_1, pmp_2, lac_2 - real :: da1, da2, a6da - - integer :: k - - logical extm (km) - - grat = del (2) / del (1) ! grid ratio - bet = grat * (grat + 0.5) - q (1) = (2. * grat * (grat + 1.) * a4 (1, 1) + a4 (1, 2)) / bet - gam (1) = (1. + grat * (grat + 1.5)) / bet - - do k = 2, km - d4 = del (k - 1) / del (k) - bet = 2. + 2. * d4 - gam (k - 1) - q (k) = (3. * (a4 (1, k - 1) + d4 * a4 (1, k)) - q (k - 1)) / bet - gam (k) = d4 / bet - enddo - - a_bot = 1. + d4 * (d4 + 1.5) - q (km + 1) = (2. * d4 * (d4 + 1.) * a4 (1, km) + a4 (1, km - 1) - a_bot * q (km)) & - / (d4 * (d4 + 0.5) - a_bot * gam (km)) - - do k = km, 1, - 1 - q (k) = q (k) - gam (k) * q (k + 1) - enddo - - ! ----------------------------------------------------------------------- - ! apply constraints - ! ----------------------------------------------------------------------- - - do k = 2, km - gam (k) = a4 (1, k) - a4 (1, k - 1) - enddo - - ! ----------------------------------------------------------------------- - ! apply large - scale constraints to all fields if not local max / min - ! ----------------------------------------------------------------------- - - ! ----------------------------------------------------------------------- - ! top: - ! ----------------------------------------------------------------------- - - q (1) = max (q (1), 0.) - q (2) = min (q (2), max (a4 (1, 1), a4 (1, 2))) - q (2) = max (q (2), min (a4 (1, 1), a4 (1, 2)), 0.) - - ! ----------------------------------------------------------------------- - ! interior: - ! ----------------------------------------------------------------------- - - do k = 3, km - 1 - if (gam (k - 1) * gam (k + 1) > 0.) then - q (k) = min (q (k), max (a4 (1, k - 1), a4 (1, k))) - q (k) = max (q (k), min (a4 (1, k - 1), a4 (1, k))) - else - if (gam (k - 1) > 0.) then - ! there exists a local max - q (k) = max (q (k), min (a4 (1, k - 1), a4 (1, k))) - else - ! there exists a local min - q (k) = min (q (k), max (a4 (1, k - 1), a4 (1, k))) - q (k) = max (q (k), 0.0) - endif - endif - enddo - - ! ----------------------------------------------------------------------- - ! bottom : - ! ----------------------------------------------------------------------- - - q (km) = min (q (km), max (a4 (1, km - 1), a4 (1, km))) - q (km) = max (q (km), min (a4 (1, km - 1), a4 (1, km)), 0.) - ! q (km + 1) = max (q (km + 1), 0.) - - ! ----------------------------------------------------------------------- - ! f (s) = al + s * [ (ar - al) + a6 * (1 - s) ] (0 <= s <= 1) - ! ----------------------------------------------------------------------- - - do k = 1, km - 1 - a4 (2, k) = q (k) - a4 (3, k) = q (k + 1) - enddo - - do k = 2, km - 1 - if (gam (k) * gam (k + 1) > 0.0) then - extm (k) = .false. - else - extm (k) = .true. - endif - enddo - - if (do_mono) then - do k = 3, km - 2 - if (extm (k)) then - ! positive definite constraint only if true local extrema - if (a4 (1, k) < qp_min .or. extm (k - 1) .or. extm (k + 1)) then - a4 (2, k) = a4 (1, k) - a4 (3, k) = a4 (1, k) - endif - else - a4 (4, k) = 6. * a4 (1, k) - 3. * (a4 (2, k) + a4 (3, k)) - if (abs (a4 (4, k)) > abs (a4 (2, k) - a4 (3, k))) then - ! check within the smooth region if subgrid profile is non - monotonic - pmp_1 = a4 (1, k) - 2.0 * gam (k + 1) - lac_1 = pmp_1 + 1.5 * gam (k + 2) - a4 (2, k) = min (max (a4 (2, k), min (a4 (1, k), pmp_1, lac_1)), & - max (a4 (1, k), pmp_1, lac_1)) - pmp_2 = a4 (1, k) + 2.0 * gam (k) - lac_2 = pmp_2 - 1.5 * gam (k - 1) - a4 (3, k) = min (max (a4 (3, k), min (a4 (1, k), pmp_2, lac_2)), & - max (a4 (1, k), pmp_2, lac_2)) - endif - endif - enddo - else - do k = 3, km - 2 - if (extm (k)) then - if (a4 (1, k) < qp_min .or. extm (k - 1) .or. extm (k + 1)) then - a4 (2, k) = a4 (1, k) - a4 (3, k) = a4 (1, k) - endif - endif - enddo - endif - - do k = 1, km - 1 - a4 (4, k) = 6. * a4 (1, k) - 3. * (a4 (2, k) + a4 (3, k)) - enddo - - k = km - 1 - if (extm (k)) then - a4 (2, k) = a4 (1, k) - a4 (3, k) = a4 (1, k) - a4 (4, k) = 0. - else - da1 = a4 (3, k) - a4 (2, k) - da2 = da1 ** 2 - a6da = a4 (4, k) * da1 - if (a6da < - da2) then - a4 (4, k) = 3. * (a4 (2, k) - a4 (1, k)) - a4 (3, k) = a4 (2, k) - a4 (4, k) - elseif (a6da > da2) then - a4 (4, k) = 3. * (a4 (3, k) - a4 (1, k)) - a4 (2, k) = a4 (3, k) - a4 (4, k) - endif - endif - - call cs_limiters (km - 1, a4) - - ! ----------------------------------------------------------------------- - ! bottom layer: - ! ----------------------------------------------------------------------- - - a4 (2, km) = a4 (1, km) - a4 (3, km) = a4 (1, km) - a4 (4, km) = 0. - -end subroutine cs_profile - -subroutine cs_limiters (km, a4) - - implicit none - - integer, intent (in) :: km - - real, intent (inout) :: a4 (4, km) !< ppm array - - real, parameter :: r12 = 1. / 12. - - integer :: k - - ! ----------------------------------------------------------------------- - ! positive definite constraint - ! ----------------------------------------------------------------------- - - do k = 1, km - if (abs (a4 (3, k) - a4 (2, k)) < - a4 (4, k)) then - if ((a4 (1, k) + 0.25 * (a4 (3, k) - a4 (2, k)) ** 2 / a4 (4, k) + a4 (4, k) * r12) < 0.) then - if (a4 (1, k) < a4 (3, k) .and. a4 (1, k) < a4 (2, k)) then - a4 (3, k) = a4 (1, k) - a4 (2, k) = a4 (1, k) - a4 (4, k) = 0. - elseif (a4 (3, k) > a4 (2, k)) then - a4 (4, k) = 3. * (a4 (2, k) - a4 (1, k)) - a4 (3, k) = a4 (2, k) - a4 (4, k) - else - a4 (4, k) = 3. * (a4 (3, k) - a4 (1, k)) - a4 (2, k) = a4 (3, k) - a4 (4, k) - endif - endif - endif - enddo - -end subroutine cs_limiters - -! ======================================================================= -!>@brief The subroutine 'fall_speed' calculates vertical fall speed. -! ======================================================================= - -subroutine fall_speed (ktop, kbot, den, qs, qi, qg, ql, tk, vts, vti, vtg) - - implicit none - - integer, intent (in) :: ktop, kbot - - real, intent (in), dimension (ktop:kbot) :: den, qs, qi, qg, ql, tk - real, intent (out), dimension (ktop:kbot) :: vts, vti, vtg - - ! fall velocity constants: - - real, parameter :: thi = 1.0e-8 !< cloud ice threshold for terminal fall - real, parameter :: thg = 1.0e-8 - real, parameter :: ths = 1.0e-8 - - real, parameter :: aa = - 4.14122e-5 - real, parameter :: bb = - 0.00538922 - real, parameter :: cc = - 0.0516344 - real, parameter :: dd = 0.00216078 - real, parameter :: ee = 1.9714 - - ! marshall - palmer constants - - real, parameter :: vcons = 6.6280504 - real, parameter :: vcong = 87.2382675 - real, parameter :: norms = 942477796.076938 - real, parameter :: normg = 5026548245.74367 - - real, dimension (ktop:kbot) :: qden, tc, rhof - - real :: vi0 - - integer :: k - - ! ----------------------------------------------------------------------- - ! marshall - palmer formula - ! ----------------------------------------------------------------------- - - ! ----------------------------------------------------------------------- - ! try the local air density -- for global model; the true value could be - ! much smaller than sfcrho over high mountains - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - rhof (k) = sqrt (min (10., sfcrho / den (k))) - enddo - - ! ----------------------------------------------------------------------- - ! ice: - ! ----------------------------------------------------------------------- - - if (const_vi) then - vti (:) = vi_fac - else - ! ----------------------------------------------------------------------- - ! use deng and mace (2008, grl), which gives smaller fall speed than hd90 formula - ! ----------------------------------------------------------------------- - vi0 = 0.01 * vi_fac - do k = ktop, kbot - if (qi (k) < thi) then ! this is needed as the fall - speed maybe problematic for small qi - vti (k) = vf_min - else - tc (k) = tk (k) - tice - vti (k) = (3. + log10 (qi (k) * den (k))) * (tc (k) * (aa * tc (k) + bb) + cc) + dd * tc (k) + ee - vti (k) = vi0 * exp (log_10 * vti (k)) * 0.8 - vti (k) = min (vi_max, max (vf_min, vti (k))) - endif - enddo - endif - - ! ----------------------------------------------------------------------- - ! snow: - ! ----------------------------------------------------------------------- - - if (const_vs) then - vts (:) = vs_fac ! 1. ifs_2016 - else - do k = ktop, kbot - if (qs (k) < ths) then - vts (k) = vf_min - else - vts (k) = vs_fac * vcons * rhof (k) * exp (0.0625 * log (qs (k) * den (k) / norms)) - vts (k) = min (vs_max, max (vf_min, vts (k))) - endif - enddo - endif - - ! ----------------------------------------------------------------------- - ! graupel: - ! ----------------------------------------------------------------------- - - if (const_vg) then - vtg (:) = vg_fac ! 2. - else - do k = ktop, kbot - if (qg (k) < thg) then - vtg (k) = vf_min - else - vtg (k) = vg_fac * vcong * rhof (k) * sqrt (sqrt (sqrt (qg (k) * den (k) / normg))) - vtg (k) = min (vg_max, max (vf_min, vtg (k))) - endif - enddo - endif - -end subroutine fall_speed - -! ======================================================================= -!>@brief The subroutine 'setup'm' sets up -!! gfdl cloud microphysics parameters. -! ======================================================================= - -subroutine setupm - - implicit none - - real :: gcon, cd, scm3, pisq, act (8) - real :: vdifu, tcond - real :: visk - real :: ch2o, hltf - real :: hlts, hltc, ri50 - - real, parameter :: gam263 = 1.456943, gam275 = 1.608355, gam290 = 1.827363, & - gam325 = 2.54925, gam350 = 3.323363, gam380 = 4.694155, & - gam425 = 8.285063, gam450 = 11.631769, gam480 = 17.837789, & - gam625 = 184.860962, gam680 = 496.604067 - - ! intercept parameters - - real, parameter :: rnzr = 8.0e6 ! lin83 - real, parameter :: rnzs = 3.0e6 ! lin83 - real, parameter :: rnzg = 4.0e6 ! rh84 - - ! density parameters - -! real, parameter :: rhos = 0.1e3 !< lin83 (snow density; 1 / 10 of water) -! real, parameter :: rhog = 0.4e3 !< rh84 (graupel density) - real, parameter :: acc (3) = (/ 5.0, 2.0, 0.5 /) - - real den_rc - - integer :: i, k - - pie = 4. * atan (1.0) - - ! s. klein's formular (eq 16) from am2 - - fac_rc = (4. / 3.) * pie * rhor * rthresh ** 3 - - if (prog_ccn) then - ! if (master) write (*, *) 'prog_ccn option is .t.' - else - den_rc = fac_rc * ccn_o * 1.e6 - ! if (master) write (*, *) 'mp: for ccn_o = ', ccn_o, 'ql_rc = ', den_rc - den_rc = fac_rc * ccn_l * 1.e6 - ! if (master) write (*, *) 'mp: for ccn_l = ', ccn_l, 'ql_rc = ', den_rc - endif - - vdifu = 2.11e-5 - tcond = 2.36e-2 - - visk = 1.259e-5 - hlts = 2.8336e6 - hltc = 2.5e6 - hltf = 3.336e5 - - ch2o = 4.1855e3 - ri50 = 1.e-4 - - pisq = pie * pie - scm3 = (visk / vdifu) ** (1. / 3.) - - cracs = pisq * rnzr * rnzs * rhos - csacr = pisq * rnzr * rnzs * rhor - cgacr = pisq * rnzr * rnzg * rhor - cgacs = pisq * rnzg * rnzs * rhos - cgacs = cgacs * c_pgacs - - ! act: 1 - 2:racs (s - r) ; 3 - 4:sacr (r - s) ; - ! 5 - 6:gacr (r - g) ; 7 - 8:gacs (s - g) - - act (1) = pie * rnzs * rhos - act (2) = pie * rnzr * rhor - act (6) = pie * rnzg * rhog - act (3) = act (2) - act (4) = act (1) - act (5) = act (2) - act (7) = act (1) - act (8) = act (6) - - do i = 1, 3 - do k = 1, 4 - acco (i, k) = acc (i) / (act (2 * k - 1) ** ((7 - i) * 0.25) * act (2 * k) ** (i * 0.25)) - enddo - enddo - - gcon = 40.74 * sqrt (sfcrho) ! 44.628 - - csacw = pie * rnzs * clin * gam325 / (4. * act (1) ** 0.8125) - ! decreasing csacw to reduce cloud water --- > snow - - craci = pie * rnzr * alin * gam380 / (4. * act (2) ** 0.95) - csaci = csacw * c_psaci - - cgacw = pie * rnzg * gam350 * gcon / (4. * act (6) ** 0.875) - ! cgaci = cgacw * 0.1 - - ! sjl, may 28, 2012 - cgaci = cgacw * 0.05 - ! sjl, may 28, 2012 - - cracw = craci ! cracw = 3.27206196043822 - cracw = c_cracw * cracw - - ! subl and revp: five constants for three separate processes - - cssub (1) = 2. * pie * vdifu * tcond * rvgas * rnzs - cgsub (1) = 2. * pie * vdifu * tcond * rvgas * rnzg - crevp (1) = 2. * pie * vdifu * tcond * rvgas * rnzr - cssub (2) = 0.78 / sqrt (act (1)) - cgsub (2) = 0.78 / sqrt (act (6)) - crevp (2) = 0.78 / sqrt (act (2)) - cssub (3) = 0.31 * scm3 * gam263 * sqrt (clin / visk) / act (1) ** 0.65625 - cgsub (3) = 0.31 * scm3 * gam275 * sqrt (gcon / visk) / act (6) ** 0.6875 - crevp (3) = 0.31 * scm3 * gam290 * sqrt (alin / visk) / act (2) ** 0.725 - cssub (4) = tcond * rvgas - cssub (5) = hlts ** 2 * vdifu - cgsub (4) = cssub (4) - crevp (4) = cssub (4) - cgsub (5) = cssub (5) - crevp (5) = hltc ** 2 * vdifu - - cgfr (1) = 20.e2 * pisq * rnzr * rhor / act (2) ** 1.75 - cgfr (2) = 0.66 - - ! smlt: five constants (lin et al. 1983) - - csmlt (1) = 2. * pie * tcond * rnzs / hltf - csmlt (2) = 2. * pie * vdifu * rnzs * hltc / hltf - csmlt (3) = cssub (2) - csmlt (4) = cssub (3) - csmlt (5) = ch2o / hltf - - ! gmlt: five constants - - cgmlt (1) = 2. * pie * tcond * rnzg / hltf - cgmlt (2) = 2. * pie * vdifu * rnzg * hltc / hltf - cgmlt (3) = cgsub (2) - cgmlt (4) = cgsub (3) - cgmlt (5) = ch2o / hltf - - es0 = 6.107799961e2 ! ~6.1 mb - ces0 = eps * es0 - -end subroutine setupm - -! ======================================================================= -! initialization of gfdl cloud microphysics -!>@brief The subroutine 'gfdl_cloud_microphys_init' initializes the GFDL -!! cloud microphysics. -! ======================================================================= - -subroutine gfdl_cloud_microphys_init (me, master, nlunit, input_nml_file, logunit, fn_nml) - - implicit none - - integer, intent (in) :: me - integer, intent (in) :: master - integer, intent (in) :: nlunit - integer, intent (in) :: logunit - - character (len = 64), intent (in) :: fn_nml - character (len = *), intent (in) :: input_nml_file(:) - - integer :: ios - logical :: exists - - ! integer, intent (in) :: id, jd, kd - ! integer, intent (in) :: axes (4) - ! type (time_type), intent (in) :: time - - ! integer :: unit, io, ierr, k, logunit - ! logical :: flag - ! real :: tmp, q1, q2 - - ! master = (mpp_pe () .eq.mpp_root_pe ()) - -#ifdef INTERNAL_FILE_NML - read (input_nml_file, nml = gfdl_cloud_microphysics_nml) -#else - inquire (file = trim (fn_nml), exist = exists) - if (.not. exists) then - write (6, *) 'gfdl - mp :: namelist file: ', trim (fn_nml), ' does not exist' - stop - else - open (unit = nlunit, file = fn_nml, readonly, status = 'old', iostat = ios) - endif - rewind (nlunit) - read (nlunit, nml = gfdl_cloud_microphysics_nml) - close (nlunit) -#endif - - ! write version number and namelist to log file - if (me == master) then - write (logunit, *) " ================================================================== " - write (logunit, *) "gfdl_cloud_microphys_mod" - write (logunit, nml = gfdl_cloud_microphysics_nml) - endif - - if (do_setup) then - call setup_con - call setupm - do_setup = .false. - endif - - log_10 = log (10.) - - tice0 = tice - 0.01 - t_wfr = tice - 40.0 ! supercooled water can exist down to - 48 c, which is the "absolute" - - ! if (master) write (logunit, nml = gfdl_cloud_microphys_nml) - ! - ! id_vtr = register_diag_field (mod_name, 'vt_r', axes (1:3), time, & - ! 'rain fall speed', 'm / s', missing_value = missing_value) - ! id_vts = register_diag_field (mod_name, 'vt_s', axes (1:3), time, & - ! 'snow fall speed', 'm / s', missing_value = missing_value) - ! id_vtg = register_diag_field (mod_name, 'vt_g', axes (1:3), time, & - ! 'graupel fall speed', 'm / s', missing_value = missing_value) - ! id_vti = register_diag_field (mod_name, 'vt_i', axes (1:3), time, & - ! 'ice fall speed', 'm / s', missing_value = missing_value) - - ! id_droplets = register_diag_field (mod_name, 'droplets', axes (1:3), time, & - ! 'droplet number concentration', '# / m3', missing_value = missing_value) - ! id_rh = register_diag_field (mod_name, 'rh_lin', axes (1:2), time, & - ! 'relative humidity', 'n / a', missing_value = missing_value) - - ! id_rain = register_diag_field (mod_name, 'rain_lin', axes (1:2), time, & - ! 'rain_lin', 'mm / day', missing_value = missing_value) - ! id_snow = register_diag_field (mod_name, 'snow_lin', axes (1:2), time, & - ! 'snow_lin', 'mm / day', missing_value = missing_value) - ! id_graupel = register_diag_field (mod_name, 'graupel_lin', axes (1:2), time, & - ! 'graupel_lin', 'mm / day', missing_value = missing_value) - ! id_ice = register_diag_field (mod_name, 'ice_lin', axes (1:2), time, & - ! 'ice_lin', 'mm / day', missing_value = missing_value) - ! id_prec = register_diag_field (mod_name, 'prec_lin', axes (1:2), time, & - ! 'prec_lin', 'mm / day', missing_value = missing_value) - - ! if (master) write (*, *) 'prec_lin diagnostics initialized.', id_prec - - ! id_cond = register_diag_field (mod_name, 'cond_lin', axes (1:2), time, & - ! 'total condensate', 'kg / m ** 2', missing_value = missing_value) - ! id_var = register_diag_field (mod_name, 'var_lin', axes (1:2), time, & - ! 'subgrid variance', 'n / a', missing_value = missing_value) - - ! call qsmith_init - - ! testing the water vapor tables - - ! if (mp_debug .and. master) then - ! write (*, *) 'testing water vapor tables in gfdl_cloud_microphys' - ! tmp = tice - 90. - ! do k = 1, 25 - ! q1 = wqsat_moist (tmp, 0., 1.e5) - ! q2 = qs1d_m (tmp, 0., 1.e5) - ! write (*, *) nint (tmp - tice), q1, q2, 'dq = ', q1 - q2 - ! tmp = tmp + 5. - ! enddo - ! endif - - ! if (master) write (*, *) 'gfdl_cloud_micrphys diagnostics initialized.' - - module_is_initialized = .true. - -!+---+-----------------------------------------------------------------+ -!..Set these variables needed for computing radar reflectivity. These -!.. get used within radar_init to create other variables used in the -!.. radar module. - - xam_r = pi*rhor/6. - xbm_r = 3. - xmu_r = 0. - xam_s = pi*rhos/6. - xbm_s = 3. - xmu_s = 0. - xam_g = pi*rhog/6. - xbm_g = 3. - xmu_g = 0. - - call radar_init - -end subroutine gfdl_cloud_microphys_init - -! ======================================================================= -! end of gfdl cloud microphysics -!>@brief The subroutine 'gfdl_cloud_microphys_init' terminates the GFDL -!! cloud microphysics. -! ======================================================================= - -subroutine gfdl_cloud_microphys_end - - implicit none - - deallocate (table) - deallocate (table2) - deallocate (table3) - deallocate (tablew) - deallocate (des) - deallocate (des2) - deallocate (des3) - deallocate (desw) - - tables_are_initialized = .false. - -end subroutine gfdl_cloud_microphys_end - -! ======================================================================= -! qsmith table initialization -!>@brief The subroutine 'setup_con' sets up constants and calls 'qsmith_init'. -! ======================================================================= - -subroutine setup_con - - implicit none - - ! master = (mpp_pe () .eq.mpp_root_pe ()) - - rgrav = 1. / grav - - if (.not. qsmith_tables_initialized) call qsmith_init - - qsmith_tables_initialized = .true. - -end subroutine setup_con - -! ======================================================================= -!>@brief The function 'acr3d' is an accretion function (lin et al. 1983) -! ======================================================================= - -real function acr3d (v1, v2, q1, q2, c, cac, rho) - - implicit none - - real, intent (in) :: v1, v2, c, rho - real, intent (in) :: q1, q2 ! mixing ratio!!! - real, intent (in) :: cac (3) - - real :: t1, s1, s2 - - ! integer :: k - ! - ! real :: a - ! - ! a = 0.0 - ! do k = 1, 3 - ! a = a + cac (k) * ((q1 * rho) ** ((7 - k) * 0.25) * (q2 * rho) ** (k * 0.25)) - ! enddo - ! acr3d = c * abs (v1 - v2) * a / rho - - ! optimized - - t1 = sqrt (q1 * rho) - s1 = sqrt (q2 * rho) - s2 = sqrt (s1) ! s1 = s2 ** 2 - acr3d = c * abs (v1 - v2) * q1 * s2 * (cac (1) * t1 + cac (2) * sqrt (t1) * s2 + cac (3) * s1) - -end function acr3d - -! ======================================================================= -!> melting of snow function (lin et al. 1983) -! note: psacw and psacr must be calc before smlt is called -! ======================================================================= - -real function smlt (tc, dqs, qsrho, psacw, psacr, c, rho, rhofac) - - implicit none - - real, intent (in) :: tc, dqs, qsrho, psacw, psacr, c (5), rho, rhofac - - smlt = (c (1) * tc / rho - c (2) * dqs) * (c (3) * sqrt (qsrho) + & - c (4) * qsrho ** 0.65625 * sqrt (rhofac)) + c (5) * tc * (psacw + psacr) - -end function smlt - -! ======================================================================= -!> melting of graupel function (lin et al. 1983) -! note: pgacw and pgacr must be calc before gmlt is called -! ======================================================================= - -real function gmlt (tc, dqs, qgrho, pgacw, pgacr, c, rho) - - implicit none - - real, intent (in) :: tc, dqs, qgrho, pgacw, pgacr, c (5), rho - - gmlt = (c (1) * tc / rho - c (2) * dqs) * (c (3) * sqrt (qgrho) + & - c (4) * qgrho ** 0.6875 / rho ** 0.25) + c (5) * tc * (pgacw + pgacr) - -end function gmlt - -! ======================================================================= -! initialization -! prepare saturation water vapor pressure tables -! ======================================================================= -!>@brief The subroutine 'qsmith_init' initializes lookup tables for saturation -!! water vapor pressure for the following utility routines that are designed -!! to return qs consistent with the assumptions in FV3. -!>@details The calculations are highly accurate values based on the Clausius-Clapeyron -!! equation. -! ======================================================================= -subroutine qsmith_init - - implicit none - - integer, parameter :: length = 2621 - - integer :: i - - if (.not. tables_are_initialized) then - - ! master = (mpp_pe () .eq. mpp_root_pe ()) - ! if (master) print *, ' gfdl mp: initializing qs tables' - - ! debug code - ! print *, mpp_pe (), allocated (table), allocated (table2), & - ! allocated (table3), allocated (tablew), allocated (des), & - ! allocated (des2), allocated (des3), allocated (desw) - ! end debug code - - ! generate es table (dt = 0.1 deg. c) - - allocate (table (length)) - allocate (table2 (length)) - allocate (table3 (length)) - allocate (tablew (length)) - allocate (des (length)) - allocate (des2 (length)) - allocate (des3 (length)) - allocate (desw (length)) - - call qs_table (length) - call qs_table2 (length) - call qs_table3 (length) - call qs_tablew (length) - - do i = 1, length - 1 - des (i) = max (0., table (i + 1) - table (i)) - des2 (i) = max (0., table2 (i + 1) - table2 (i)) - des3 (i) = max (0., table3 (i + 1) - table3 (i)) - desw (i) = max (0., tablew (i + 1) - tablew (i)) - enddo - des (length) = des (length - 1) - des2 (length) = des2 (length - 1) - des3 (length) = des3 (length - 1) - desw (length) = desw (length - 1) - - tables_are_initialized = .true. - - endif - -end subroutine qsmith_init - -! ======================================================================= -! compute the saturated specific humidity for table ii -!>@brief The function 'wqs1' returns the saturation vapor pressure over pure -!! liquid water for a given temperature and air density. -! ======================================================================= - -real function wqs1 (ta, den) - - implicit none - - !> pure water phase; universal dry / moist formular using air density - !> input "den" can be either dry or moist air density - - real, intent (in) :: ta, den - - real :: es, ap1, tmin - - integer :: it - - tmin = table_ice - 160. - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es = tablew (it) + (ap1 - it) * desw (it) - wqs1 = es / (rvgas * ta * den) - -end function wqs1 - -! ======================================================================= -! compute the gradient of saturated specific humidity for table ii -!>@brief The function 'wqs2' returns the saturation vapor pressure over pure -!! liquid water for a given temperature and air density, as well as the -!! analytic dqs/dT: rate of change of saturation vapor pressure WRT temperature. -! ======================================================================= - -real function wqs2 (ta, den, dqdt) - - implicit none - - !> pure water phase; universal dry / moist formular using air density - !> input "den" can be either dry or moist air density - - real, intent (in) :: ta, den - - real, intent (out) :: dqdt - - real :: es, ap1, tmin - - integer :: it - - tmin = table_ice - 160. - - if (.not. tables_are_initialized) call qsmith_init - - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es = tablew (it) + (ap1 - it) * desw (it) - wqs2 = es / (rvgas * ta * den) - it = ap1 - 0.5 - ! finite diff, del_t = 0.1: - dqdt = 10. * (desw (it) + (ap1 - it) * (desw (it + 1) - desw (it))) / (rvgas * ta * den) - -end function wqs2 - -! ======================================================================= -! compute wet buld temperature -!>@brief The function 'wet_bulb' uses 'wqs2' to compute the wet-bulb temperature -!! from the mixing ratio and the temperature. -! ======================================================================= - -real function wet_bulb (q, t, den) - - implicit none - - real, intent (in) :: t, q, den - - real :: qs, tp, dqdt - - wet_bulb = t - qs = wqs2 (wet_bulb, den, dqdt) - tp = 0.5 * (qs - q) / (1. + lcp * dqdt) * lcp - wet_bulb = wet_bulb - tp - - ! tp is negative if super - saturated - if (tp > 0.01) then - qs = wqs2 (wet_bulb, den, dqdt) - tp = (qs - q) / (1. + lcp * dqdt) * lcp - wet_bulb = wet_bulb - tp - endif - -end function wet_bulb - -! ======================================================================= -!>@brief The function 'iqs1' computes the saturated specific humidity -!! for table iii -! ======================================================================= - -real function iqs1 (ta, den) - - implicit none - - !> water - ice phase; universal dry / moist formular using air density - !> input "den" can be either dry or moist air density - - real, intent (in) :: ta, den - - real :: es, ap1, tmin - - integer :: it - - tmin = table_ice - 160. - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es = table2 (it) + (ap1 - it) * des2 (it) - iqs1 = es / (rvgas * ta * den) - -end function iqs1 - -! ======================================================================= -!>@brief The function 'iqs2' computes the gradient of saturated specific -!! humidity for table iii -! ======================================================================= - -real function iqs2 (ta, den, dqdt) - - implicit none - - !> water - ice phase; universal dry / moist formular using air density - !> input "den" can be either dry or moist air density - - real, intent (in) :: ta, den - - real, intent (out) :: dqdt - - real :: es, ap1, tmin - - integer :: it - - tmin = table_ice - 160. - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es = table2 (it) + (ap1 - it) * des2 (it) - iqs2 = es / (rvgas * ta * den) - it = ap1 - 0.5 - dqdt = 10. * (des2 (it) + (ap1 - it) * (des2 (it + 1) - des2 (it))) / (rvgas * ta * den) - -end function iqs2 - -! ======================================================================= -!>@brief The function 'qs1d_moist' computes the gradient of saturated -!! specific humidity for table iii. -! ======================================================================= - -real function qs1d_moist (ta, qv, pa, dqdt) - - implicit none - - real, intent (in) :: ta, pa, qv - - real, intent (out) :: dqdt - - real :: es, ap1, tmin, eps10 - - integer :: it - - tmin = table_ice - 160. - eps10 = 10. * eps - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es = table2 (it) + (ap1 - it) * des2 (it) - qs1d_moist = eps * es * (1. + zvir * qv) / pa - it = ap1 - 0.5 - dqdt = eps10 * (des2 (it) + (ap1 - it) * (des2 (it + 1) - des2 (it))) * (1. + zvir * qv) / pa - -end function qs1d_moist - -! ======================================================================= -! compute the gradient of saturated specific humidity for table ii -!>@brief The function 'wqsat2_moist' computes the saturated specific humidity -!! for pure liquid water , as well as des/dT. -! ======================================================================= - -real function wqsat2_moist (ta, qv, pa, dqdt) - - implicit none - - real, intent (in) :: ta, pa, qv - - real, intent (out) :: dqdt - - real :: es, ap1, tmin, eps10 - - integer :: it - - tmin = table_ice - 160. - eps10 = 10. * eps - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es = tablew (it) + (ap1 - it) * desw (it) - wqsat2_moist = eps * es * (1. + zvir * qv) / pa - it = ap1 - 0.5 - dqdt = eps10 * (desw (it) + (ap1 - it) * (desw (it + 1) - desw (it))) * (1. + zvir * qv) / pa - -end function wqsat2_moist - -! ======================================================================= -! compute the saturated specific humidity for table ii -!>@brief The function 'wqsat_moist' computes the saturated specific humidity -!! for pure liquid water. -! ======================================================================= - -real function wqsat_moist (ta, qv, pa) - - implicit none - - real, intent (in) :: ta, pa, qv - - real :: es, ap1, tmin - - integer :: it - - tmin = table_ice - 160. - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es = tablew (it) + (ap1 - it) * desw (it) - wqsat_moist = eps * es * (1. + zvir * qv) / pa - -end function wqsat_moist - -! ======================================================================= -!>@brief The function 'qs1d_m' computes the saturated specific humidity -!! for table iii -! ======================================================================= - -real function qs1d_m (ta, qv, pa) - - implicit none - - real, intent (in) :: ta, pa, qv - - real :: es, ap1, tmin - - integer :: it - - tmin = table_ice - 160. - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es = table2 (it) + (ap1 - it) * des2 (it) - qs1d_m = eps * es * (1. + zvir * qv) / pa - -end function qs1d_m - -! ======================================================================= -!>@brief The function 'd_sat' computes the difference in saturation -!! vapor * density * between water and ice -! ======================================================================= - -real function d_sat (ta, den) - - implicit none - - real, intent (in) :: ta, den - - real :: es_w, es_i, ap1, tmin - - integer :: it - - tmin = table_ice - 160. - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es_w = tablew (it) + (ap1 - it) * desw (it) - es_i = table2 (it) + (ap1 - it) * des2 (it) - d_sat = dim (es_w, es_i) / (rvgas * ta * den) ! take positive difference - -end function d_sat - -! ======================================================================= -!>@brief The function 'esw_table' computes the saturated water vapor -!! pressure for table ii -! ======================================================================= - -real function esw_table (ta) - - implicit none - - real, intent (in) :: ta - - real :: ap1, tmin - - integer :: it - - tmin = table_ice - 160. - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - esw_table = tablew (it) + (ap1 - it) * desw (it) - -end function esw_table - -! ======================================================================= -!>@brief The function 'es2_table' computes the saturated water -!! vapor pressure for table iii -! ======================================================================= - -real function es2_table (ta) - - implicit none - - real, intent (in) :: ta - - real :: ap1, tmin - - integer :: it - - tmin = table_ice - 160. - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es2_table = table2 (it) + (ap1 - it) * des2 (it) - -end function es2_table - -! ======================================================================= -!>@brief The subroutine 'esw_table1d' computes the saturated water vapor -!! pressure for table ii. -! ======================================================================= - -subroutine esw_table1d (ta, es, n) - - implicit none - - integer, intent (in) :: n - - real, intent (in) :: ta (n) - - real, intent (out) :: es (n) - - real :: ap1, tmin - - integer :: i, it - - tmin = table_ice - 160. - - do i = 1, n - ap1 = 10. * dim (ta (i), tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es (i) = tablew (it) + (ap1 - it) * desw (it) - enddo - -end subroutine esw_table1d - -! ======================================================================= -!>@brief The subroutine 'es3_table1d' computes the saturated water vapor -!! pressure for table iii. -! ======================================================================= - -subroutine es2_table1d (ta, es, n) - - implicit none - - integer, intent (in) :: n - - real, intent (in) :: ta (n) - - real, intent (out) :: es (n) - - real :: ap1, tmin - - integer :: i, it - - tmin = table_ice - 160. - - do i = 1, n - ap1 = 10. * dim (ta (i), tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es (i) = table2 (it) + (ap1 - it) * des2 (it) - enddo - -end subroutine es2_table1d - -! ======================================================================= -!>@brief The subroutine 'es3_table1d' computes the saturated water vapor -!! pressure for table iv. -! ======================================================================= - -subroutine es3_table1d (ta, es, n) - - implicit none - - integer, intent (in) :: n - - real, intent (in) :: ta (n) - - real, intent (out) :: es (n) - - real :: ap1, tmin - - integer :: i, it - - tmin = table_ice - 160. - - do i = 1, n - ap1 = 10. * dim (ta (i), tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es (i) = table3 (it) + (ap1 - it) * des3 (it) - enddo - -end subroutine es3_table1d - -! ======================================================================= -!>@brief saturation water vapor pressure table ii -! 1 - phase table -! ======================================================================= - -subroutine qs_tablew (n) - - implicit none - - integer, intent (in) :: n - - real :: delt = 0.1 - real :: tmin, tem, fac0, fac1, fac2 - - integer :: i - - tmin = table_ice - 160. - - ! ----------------------------------------------------------------------- - ! compute es over water - ! ----------------------------------------------------------------------- - - do i = 1, n - tem = tmin + delt * real (i - 1) - fac0 = (tem - t_ice) / (tem * t_ice) - fac1 = fac0 * lv0 - fac2 = (dc_vap * log (tem / t_ice) + fac1) / rvgas - tablew (i) = e00 * exp (fac2) - enddo - -end subroutine qs_tablew - -! ======================================================================= -!>@brief saturation water vapor pressure table iii -! 2 - phase table -! ======================================================================= - -subroutine qs_table2 (n) - - implicit none - - integer, intent (in) :: n - - real :: delt = 0.1 - real :: tmin, tem0, tem1, fac0, fac1, fac2 - - integer :: i, i0, i1 - - tmin = table_ice - 160. - - do i = 1, n - tem0 = tmin + delt * real (i - 1) - fac0 = (tem0 - t_ice) / (tem0 * t_ice) - if (i <= 1600) then - ! ----------------------------------------------------------------------- - ! compute es over ice between - 160 deg c and 0 deg c. - ! ----------------------------------------------------------------------- - fac1 = fac0 * li2 - fac2 = (d2ice * log (tem0 / t_ice) + fac1) / rvgas - else - ! ----------------------------------------------------------------------- - ! compute es over water between 0 deg c and 102 deg c. - ! ----------------------------------------------------------------------- - fac1 = fac0 * lv0 - fac2 = (dc_vap * log (tem0 / t_ice) + fac1) / rvgas - endif - table2 (i) = e00 * exp (fac2) - enddo - - ! ----------------------------------------------------------------------- - ! smoother around 0 deg c - ! ----------------------------------------------------------------------- - - i0 = 1600 - i1 = 1601 - tem0 = 0.25 * (table2 (i0 - 1) + 2. * table (i0) + table2 (i0 + 1)) - tem1 = 0.25 * (table2 (i1 - 1) + 2. * table (i1) + table2 (i1 + 1)) - table2 (i0) = tem0 - table2 (i1) = tem1 - -end subroutine qs_table2 - -! ======================================================================= -!>@brief saturation water vapor pressure table iv -! 2 - phase table with " - 2 c" as the transition point -! ======================================================================= - -subroutine qs_table3 (n) - - implicit none - - integer, intent (in) :: n - - real :: delt = 0.1 - real :: esbasw, tbasw, esbasi, tmin, tem, aa, b, c, d, e - real :: tem0, tem1 - - integer :: i, i0, i1 - - esbasw = 1013246.0 - tbasw = table_ice + 100. - esbasi = 6107.1 - tmin = table_ice - 160. - - do i = 1, n - tem = tmin + delt * real (i - 1) - ! if (i <= 1600) then - if (i <= 1580) then ! change to - 2 c - ! ----------------------------------------------------------------------- - ! compute es over ice between - 160 deg c and 0 deg c. - ! see smithsonian meteorological tables page 350. - ! ----------------------------------------------------------------------- - aa = - 9.09718 * (table_ice / tem - 1.) - b = - 3.56654 * alog10 (table_ice / tem) - c = 0.876793 * (1. - tem / table_ice) - e = alog10 (esbasi) - table3 (i) = 0.1 * 10 ** (aa + b + c + e) - else - ! ----------------------------------------------------------------------- - ! compute es over water between - 2 deg c and 102 deg c. - ! see smithsonian meteorological tables page 350. - ! ----------------------------------------------------------------------- - aa = - 7.90298 * (tbasw / tem - 1.) - b = 5.02808 * alog10 (tbasw / tem) - c = - 1.3816e-7 * (10 ** ((1. - tem / tbasw) * 11.344) - 1.) - d = 8.1328e-3 * (10 ** ((tbasw / tem - 1.) * (- 3.49149)) - 1.) - e = alog10 (esbasw) - table3 (i) = 0.1 * 10 ** (aa + b + c + d + e) - endif - enddo - - ! ----------------------------------------------------------------------- - ! smoother around - 2 deg c - ! ----------------------------------------------------------------------- - - i0 = 1580 - i1 = 1581 - tem0 = 0.25 * (table3 (i0 - 1) + 2. * table (i0) + table3 (i0 + 1)) - tem1 = 0.25 * (table3 (i1 - 1) + 2. * table (i1) + table3 (i1 + 1)) - table3 (i0) = tem0 - table3 (i1) = tem1 - -end subroutine qs_table3 - -! ======================================================================= -! compute the saturated specific humidity for table -! note: this routine is based on "moist" mixing ratio -!>@brief The function 'qs_blend' computes the saturated specific humidity -!! with a blend of water and ice depending on the temperature. -! ======================================================================= - -real function qs_blend (t, p, q) - - implicit none - - real, intent (in) :: t, p, q - - real :: es, ap1, tmin - - integer :: it - - tmin = table_ice - 160. - ap1 = 10. * dim (t, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es = table (it) + (ap1 - it) * des (it) - qs_blend = eps * es * (1. + zvir * q) / p - -end function qs_blend - -! ======================================================================= -!>@brief saturation water vapor pressure table i -! 3 - phase table -! ======================================================================= - -subroutine qs_table (n) - - implicit none - - integer, intent (in) :: n - - real :: delt = 0.1 - real :: tmin, tem, esh20 - real :: wice, wh2o, fac0, fac1, fac2 - real :: esupc (200) - - integer :: i - - tmin = table_ice - 160. - - ! ----------------------------------------------------------------------- - ! compute es over ice between - 160 deg c and 0 deg c. - ! ----------------------------------------------------------------------- - - do i = 1, 1600 - tem = tmin + delt * real (i - 1) - fac0 = (tem - t_ice) / (tem * t_ice) - fac1 = fac0 * li2 - fac2 = (d2ice * log (tem / t_ice) + fac1) / rvgas - table (i) = e00 * exp (fac2) - enddo - - ! ----------------------------------------------------------------------- - ! compute es over water between - 20 deg c and 102 deg c. - ! ----------------------------------------------------------------------- - - do i = 1, 1221 - tem = 253.16 + delt * real (i - 1) - fac0 = (tem - t_ice) / (tem * t_ice) - fac1 = fac0 * lv0 - fac2 = (dc_vap * log (tem / t_ice) + fac1) / rvgas - esh20 = e00 * exp (fac2) - if (i <= 200) then - esupc (i) = esh20 - else - table (i + 1400) = esh20 - endif - enddo - - ! ----------------------------------------------------------------------- - ! derive blended es over ice and supercooled water between - 20 deg c and 0 deg c - ! ----------------------------------------------------------------------- - - do i = 1, 200 - tem = 253.16 + delt * real (i - 1) - wice = 0.05 * (table_ice - tem) - wh2o = 0.05 * (tem - 253.16) - table (i + 1400) = wice * table (i + 1400) + wh2o * esupc (i) - enddo - -end subroutine qs_table - -! ======================================================================= -! compute the saturated specific humidity and the gradient of saturated specific humidity -! input t in deg k, p in pa; p = rho rdry tv, moist pressure -!>@brief The function 'qsmith' computes the saturated specific humidity -!! with a blend of water and ice depending on the temperature in 3D. -!@details It als oincludes the option for computing des/dT. -! ======================================================================= - -subroutine qsmith (im, km, ks, t, p, q, qs, dqdt) - - implicit none - - integer, intent (in) :: im, km, ks - - real, intent (in), dimension (im, km) :: t, p, q - - real, intent (out), dimension (im, km) :: qs - - real, intent (out), dimension (im, km), optional :: dqdt - - real :: eps10, ap1, tmin - - real, dimension (im, km) :: es - - integer :: i, k, it - - tmin = table_ice - 160. - eps10 = 10. * eps - - if (.not. tables_are_initialized) then - call qsmith_init - endif - - do k = ks, km - do i = 1, im - ap1 = 10. * dim (t (i, k), tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es (i, k) = table (it) + (ap1 - it) * des (it) - qs (i, k) = eps * es (i, k) * (1. + zvir * q (i, k)) / p (i, k) - enddo - enddo - - if (present (dqdt)) then - do k = ks, km - do i = 1, im - ap1 = 10. * dim (t (i, k), tmin) + 1. - ap1 = min (2621., ap1) - 0.5 - it = ap1 - dqdt (i, k) = eps10 * (des (it) + (ap1 - it) * (des (it + 1) - des (it))) * (1. + zvir * q (i, k)) / p (i, k) - enddo - enddo - endif - -end subroutine qsmith - -! ======================================================================= -!>@brief The subroutine 'neg_adj' fixes negative water species. -!>@details This is designed for 6-class micro-physics schemes. -! ======================================================================= - -subroutine neg_adj (ktop, kbot, pt, dp, qv, ql, qr, qi, qs, qg) - - implicit none - - integer, intent (in) :: ktop, kbot - - real, intent (in), dimension (ktop:kbot) :: dp - - real, intent (inout), dimension (ktop:kbot) :: pt, qv, ql, qr, qi, qs, qg - - real, dimension (ktop:kbot) :: lcpk, icpk - - real :: dq, cvm - - integer :: k - - ! ----------------------------------------------------------------------- - ! define heat capacity and latent heat coefficient - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - cvm = c_air + qv (k) * c_vap + (qr (k) + ql (k)) * c_liq + (qi (k) + qs (k) + qg (k)) * c_ice - lcpk (k) = (lv00 + d0_vap * pt (k)) / cvm - icpk (k) = (li00 + dc_ice * pt (k)) / cvm - enddo - - do k = ktop, kbot - - ! ----------------------------------------------------------------------- - ! ice phase: - ! ----------------------------------------------------------------------- - - ! if cloud ice < 0, borrow from snow - if (qi (k) < 0.) then - qs (k) = qs (k) + qi (k) - qi (k) = 0. - endif - ! if snow < 0, borrow from graupel - if (qs (k) < 0.) then - qg (k) = qg (k) + qs (k) - qs (k) = 0. - endif - ! if graupel < 0, borrow from rain - if (qg (k) < 0.) then - qr (k) = qr (k) + qg (k) - pt (k) = pt (k) - qg (k) * icpk (k) ! heating - qg (k) = 0. - endif - - ! ----------------------------------------------------------------------- - ! liquid phase: - ! ----------------------------------------------------------------------- - - ! if rain < 0, borrow from cloud water - if (qr (k) < 0.) then - ql (k) = ql (k) + qr (k) - qr (k) = 0. - endif - ! if cloud water < 0, borrow from water vapor - if (ql (k) < 0.) then - qv (k) = qv (k) + ql (k) - pt (k) = pt (k) - ql (k) * lcpk (k) ! heating - ql (k) = 0. - endif - - enddo - - ! ----------------------------------------------------------------------- - ! fix water vapor; borrow from below - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - 1 - if (qv (k) < 0.) then - qv (k + 1) = qv (k + 1) + qv (k) * dp (k) / dp (k + 1) - qv (k) = 0. - endif - enddo - - ! ----------------------------------------------------------------------- - ! bottom layer; borrow from above - ! ----------------------------------------------------------------------- - - if (qv (kbot) < 0. .and. qv (kbot - 1) > 0.) then - dq = min (- qv (kbot) * dp (kbot), qv (kbot - 1) * dp (kbot - 1)) - qv (kbot - 1) = qv (kbot - 1) - dq / dp (kbot - 1) - qv (kbot) = qv (kbot) + dq / dp (kbot) - endif - -end subroutine neg_adj - -! ======================================================================= -! compute global sum -!>@brief quick local sum algorithm -! ======================================================================= - -!real function g_sum (p, ifirst, ilast, jfirst, jlast, area, mode) -! -! use mpp_mod, only: mpp_sum -! -! implicit none -! -! integer, intent (in) :: ifirst, ilast, jfirst, jlast -! integer, intent (in) :: mode ! if == 1 divided by area -! -! real, intent (in), dimension (ifirst:ilast, jfirst:jlast) :: p, area -! -! integer :: i, j -! -! real :: gsum -! -! if (global_area < 0.) then -! global_area = 0. -! do j = jfirst, jlast -! do i = ifirst, ilast -! global_area = global_area + area (i, j) -! enddo -! enddo -! call mpp_sum (global_area) -! endif -! -! gsum = 0. -! do j = jfirst, jlast -! do i = ifirst, ilast -! gsum = gsum + p (i, j) * area (i, j) -! enddo -! enddo -! call mpp_sum (gsum) -! -! if (mode == 1) then -! g_sum = gsum / global_area -! else -! g_sum = gsum -! endif -! -!end function g_sum - -! ========================================================================== -!>@brief The subroutine 'interpolate_z' interpolates to a prescribed height. -! ========================================================================== - -subroutine interpolate_z (is, ie, js, je, km, zl, hgt, a3, a2) - - implicit none - - integer, intent (in) :: is, ie, js, je, km - - real, intent (in), dimension (is:ie, js:je, km) :: a3 - - real, intent (in), dimension (is:ie, js:je, km + 1) :: hgt !< hgt (k) > hgt (k + 1) - - real, intent (in) :: zl - - real, intent (out), dimension (is:ie, js:je) :: a2 - - real, dimension (km) :: zm !< middle layer height - - integer :: i, j, k - - !$omp parallel do default (none) shared (is, ie, js, je, km, hgt, zl, a2, a3) private (zm) - - do j = js, je - do i = is, ie - do k = 1, km - zm (k) = 0.5 * (hgt (i, j, k) + hgt (i, j, k + 1)) - enddo - if (zl >= zm (1)) then - a2 (i, j) = a3 (i, j, 1) - elseif (zl <= zm (km)) then - a2 (i, j) = a3 (i, j, km) - else - do k = 1, km - 1 - if (zl <= zm (k) .and. zl >= zm (k + 1)) then - a2 (i, j) = a3 (i, j, k) + (a3 (i, j, k + 1) - a3 (i, j, k)) * (zm (k) - zl) / (zm (k) - zm (k + 1)) - exit - endif - enddo - endif - enddo - enddo - -end subroutine interpolate_z - -! ======================================================================= -!>@brief The subroutine 'cloud_diagnosis' diagnoses the radius of cloud -!! species. -!>author Linjiong Zhoum, Shian-Jiann Lin -! ======================================================================= - -subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, qmg, t, & - rew, rei, rer, res, reg) - - implicit none - - integer, intent (in) :: is, ie, ks, ke - integer, intent (in), dimension (is:ie) :: lsm ! land sea mask, 0: ocean, 1: land, 2: sea ice - - real, intent (in), dimension (is:ie, ks:ke) :: den, delp, t - real, intent (in), dimension (is:ie, ks:ke) :: qmw, qmi, qmr, qms, qmg !< units: kg / kg - - real, intent (out), dimension (is:ie, ks:ke) :: rew, rei, rer, res, reg !< units: micron - - real, dimension (is:ie, ks:ke) :: qcw, qci, qcr, qcs, qcg !< units: g / m^2 - - integer :: i, k - - real :: lambdar, lambdas, lambdag - real :: dpg, rei_fac, mask, ccn, bw - real, parameter :: rho_0 = 50.e-3 - - real :: rhow = 1.0e3, rhor = 1.0e3, rhos = 1.0e2, rhog = 4.0e2 - real :: n0r = 8.0e6, n0s = 3.0e6, n0g = 4.0e6 - real :: alphar = 0.8, alphas = 0.25, alphag = 0.5 - real :: gammar = 17.837789, gammas = 8.2850630, gammag = 11.631769 - real :: qmin = 1.0e-12, beta = 1.22 - - do k = ks, ke - do i = is, ie - - dpg = abs (delp (i, k)) / grav - mask = min (max (real(lsm (i)), 0.0), 2.0) - - ! ----------------------------------------------------------------------- - ! cloud water (Martin et al., 1994) - ! ----------------------------------------------------------------------- - - ccn = 0.80 * (- 1.15e-3 * (ccn_o ** 2) + 0.963 * ccn_o + 5.30) * abs (mask - 1.0) + & - 0.67 * (- 2.10e-4 * (ccn_l ** 2) + 0.568 * ccn_l - 27.9) * (1.0 - abs (mask - 1.0)) - - if (qmw (i, k) .gt. qmin) then - qcw (i, k) = dpg * qmw (i, k) * 1.0e3 - rew (i, k) = exp (1.0 / 3.0 * log ((3.0 * den (i, k) * qmw (i, k)) / (4.0 * pi * rhow * ccn))) * 1.0e4 - rew (i, k) = max (rewmin, min (rewmax, rew (i, k))) - else - qcw (i, k) = 0.0 - rew (i, k) = rewmin - endif - - if (reiflag .eq. 1) then - - ! ----------------------------------------------------------------------- - ! cloud ice (Heymsfield and Mcfarquhar, 1996) - ! ----------------------------------------------------------------------- - - if (qmi (i, k) .gt. qmin) then - qci (i, k) = dpg * qmi (i, k) * 1.0e3 - rei_fac = log (1.0e3 * qmi (i, k) * den (i, k)) - if (t (i, k) - tice .lt. - 50) then - rei (i, k) = beta / 9.917 * exp (0.109 * rei_fac) * 1.0e3 - elseif (t (i, k) - tice .lt. - 40) then - rei (i, k) = beta / 9.337 * exp (0.080 * rei_fac) * 1.0e3 - elseif (t (i, k) - tice .lt. - 30) then - rei (i, k) = beta / 9.208 * exp (0.055 * rei_fac) * 1.0e3 - else - rei (i, k) = beta / 9.387 * exp (0.031 * rei_fac) * 1.0e3 - endif - rei (i, k) = max (reimin, min (reimax, rei (i, k))) - else - qci (i, k) = 0.0 - rei (i, k) = reimin - endif - - endif - - if (reiflag .eq. 2) then - - ! ----------------------------------------------------------------------- - ! cloud ice (Wyser, 1998) - ! ----------------------------------------------------------------------- - - if (qmi (i, k) .gt. qmin) then - qci (i, k) = dpg * qmi (i, k) * 1.0e3 - bw = - 2. + 1.e-3 * log10 (den (i, k) * qmi (i, k) / rho_0) * max (0.0, tice - t (i, k)) ** 1.5 - rei (i, k) = 377.4 + bw * (203.3 + bw * (37.91 + 2.3696 * bw)) - rei (i, k) = max (reimin, min (reimax, rei (i, k))) - else - qci (i, k) = 0.0 - rei (i, k) = reimin - endif - - endif - - ! ----------------------------------------------------------------------- - ! rain (Lin et al., 1983) - ! ----------------------------------------------------------------------- - - if (qmr (i, k) .gt. qmin) then - qcr (i, k) = dpg * qmr (i, k) * 1.0e3 - lambdar = exp (0.25 * log (pi * rhor * n0r / qmr (i, k) / den (i, k))) - rer (i, k) = 0.5 * exp (log (gammar / 6) / alphar) / lambdar * 1.0e6 - rer (i, k) = max (rermin, min (rermax, rer (i, k))) - else - qcr (i, k) = 0.0 - rer (i, k) = rermin - endif - - ! ----------------------------------------------------------------------- - ! snow (Lin et al., 1983) - ! ----------------------------------------------------------------------- - - if (qms (i, k) .gt. qmin) then - qcs (i, k) = dpg * qms (i, k) * 1.0e3 - lambdas = exp (0.25 * log (pi * rhos * n0s / qms (i, k) / den (i, k))) - res (i, k) = 0.5 * exp (log (gammas / 6) / alphas) / lambdas * 1.0e6 - res (i, k) = max (resmin, min (resmax, res (i, k))) - else - qcs (i, k) = 0.0 - res (i, k) = resmin - endif - - ! ----------------------------------------------------------------------- - ! graupel (Lin et al., 1983) - ! ----------------------------------------------------------------------- - - if (qmg (i, k) .gt. qmin) then - qcg (i, k) = dpg * qmg (i, k) * 1.0e3 - lambdag = exp (0.25 * log (pi * rhog * n0g / qmg (i, k) / den (i, k))) - reg (i, k) = 0.5 * exp (log (gammag / 6) / alphag) / lambdag * 1.0e6 - reg (i, k) = max (regmin, min (regmax, reg (i, k))) - else - qcg (i, k) = 0.0 - reg (i, k) = regmin - endif - - enddo - enddo - -end subroutine cloud_diagnosis - -!+---+-----------------------------------------------------------------+ - - subroutine refl10cm_gfdl (qv1d, qr1d, qs1d, qg1d, & - t1d, p1d, dBZ, kts, kte, ii,jj, melti) - - IMPLICIT NONE - -!..Sub arguments - INTEGER, INTENT(IN):: kts, kte, ii,jj - REAL, DIMENSION(kts:kte), INTENT(IN):: & - qv1d, qr1d, qs1d, qg1d, t1d, p1d - REAL, DIMENSION(kts:kte), INTENT(INOUT):: dBZ - -!..Local variables - REAL, DIMENSION(kts:kte):: temp, pres, qv, rho - REAL, DIMENSION(kts:kte):: rr, rs, rg -! REAL:: temp_C - - DOUBLE PRECISION, DIMENSION(kts:kte):: ilamr, ilams, ilamg - DOUBLE PRECISION, DIMENSION(kts:kte):: N0_r, N0_s, N0_g - DOUBLE PRECISION:: lamr, lams, lamg - LOGICAL, DIMENSION(kts:kte):: L_qr, L_qs, L_qg - - REAL, DIMENSION(kts:kte):: ze_rain, ze_snow, ze_graupel - DOUBLE PRECISION:: fmelt_s, fmelt_g - - INTEGER:: i, k, k_0, kbot, n - LOGICAL, INTENT(IN):: melti - DOUBLE PRECISION:: cback, x, eta, f_d -!+---+ - - do k = kts, kte - dBZ(k) = -35.0 - enddo - -!+---+-----------------------------------------------------------------+ -!..Put column of data into local arrays. -!+---+-----------------------------------------------------------------+ - do k = kts, kte - temp(k) = t1d(k) -! temp_C = min(-0.001, temp(K)-273.15) - qv(k) = MAX(1.E-10, qv1d(k)) - pres(k) = p1d(k) - rho(k) = 0.622*pres(k)/(rdgas*temp(k)*(qv(k)+0.622)) - - if (qr1d(k) .gt. 1.E-9) then - rr(k) = qr1d(k)*rho(k) - N0_r(k) = n0r - lamr = (xam_r*xcrg(3)*N0_r(k)/rr(k))**(1./xcre(1)) - ilamr(k) = 1./lamr - L_qr(k) = .true. - else - rr(k) = 1.E-12 - L_qr(k) = .false. - endif - - if (qs1d(k) .gt. 1.E-9) then - rs(k) = qs1d(k)*rho(k) - N0_s(k) = n0s - lams = (xam_s*xcsg(3)*N0_s(k)/rs(k))**(1./xcse(1)) - ilams(k) = 1./lams - L_qs(k) = .true. - else - rs(k) = 1.E-12 - L_qs(k) = .false. - endif - - if (qg1d(k) .gt. 1.E-9) then - rg(k) = qg1d(k)*rho(k) - N0_g(k) = n0g - lamg = (xam_g*xcgg(3)*N0_g(k)/rg(k))**(1./xcge(1)) - ilamg(k) = 1./lamg - L_qg(k) = .true. - else - rg(k) = 1.E-12 - L_qg(k) = .false. - endif - enddo - -!+---+-----------------------------------------------------------------+ -!..Locate K-level of start of melting (k_0 is level above). -!+---+-----------------------------------------------------------------+ - k_0 = kts - K_LOOP:do k = kte-1, kts, -1 - if ( melti .and. (temp(k).gt.273.15) .and. L_qr(k) & - .and. (L_qs(k+1).or.L_qg(k+1)) ) then - k_0 = MAX(k+1, k_0) - EXIT K_LOOP - endif - enddo K_LOOP -!+---+-----------------------------------------------------------------+ -!..Assume Rayleigh approximation at 10 cm wavelength. Rain (all temps) -!.. and non-water-coated snow and graupel when below freezing are -!.. simple. Integrations of m(D)*m(D)*N(D)*dD. -!+---+-----------------------------------------------------------------+ - do k = kts, kte - ze_rain(k) = 1.e-22 - ze_snow(k) = 1.e-22 - ze_graupel(k) = 1.e-22 - if (L_qr(k)) ze_rain(k) = N0_r(k)*xcrg(4)*ilamr(k)**xcre(4) - if (L_qs(k)) ze_snow(k) = (0.176/0.93) * (6.0/PI)*(6.0/PI) & - * (xam_s/900.0)*(xam_s/900.0) & - * N0_s(k)*xcsg(4)*ilams(k)**xcse(4) - if (L_qg(k)) ze_graupel(k) = (0.176/0.93) * (6.0/PI)*(6.0/PI) & - * (xam_g/900.0)*(xam_g/900.0) & - * N0_g(k)*xcgg(4)*ilamg(k)**xcge(4) - enddo - - -!+---+-----------------------------------------------------------------+ -!..Special case of melting ice (snow/graupel) particles. Assume the -!.. ice is surrounded by the liquid water. Fraction of meltwater is -!.. extremely simple based on amount found above the melting level. -!.. Uses code from Uli Blahak (rayleigh_soak_wetgraupel and supporting -!.. routines). -!+---+-----------------------------------------------------------------+ - - if (melti .and. k_0.ge.kts+1) then - do k = k_0-1, kts, -1 - -!..Reflectivity contributed by melting snow - if (L_qs(k) .and. L_qs(k_0) ) then - fmelt_s = MAX(0.005d0, MIN(1.0d0-rs(k)/rs(k_0), 0.99d0)) - eta = 0.d0 - lams = 1./ilams(k) - do n = 1, nrbins - x = xam_s * xxDs(n)**xbm_s - call rayleigh_soak_wetgraupel (x,DBLE(xocms),DBLE(xobms), & - fmelt_s, melt_outside_s, m_w_0, m_i_0, lamda_radar, & - CBACK, mixingrulestring_s, matrixstring_s, & - inclusionstring_s, hoststring_s, & - hostmatrixstring_s, hostinclusionstring_s) - f_d = N0_s(k)*xxDs(n)**xmu_s * DEXP(-lams*xxDs(n)) - eta = eta + f_d * CBACK * simpson(n) * xdts(n) - enddo - ze_snow(k) = SNGL(lamda4 / (pi5 * K_w) * eta) - endif - - -!..Reflectivity contributed by melting graupel - - if (L_qg(k) .and. L_qg(k_0) ) then - fmelt_g = MAX(0.005d0, MIN(1.0d0-rg(k)/rg(k_0), 0.99d0)) - eta = 0.d0 - lamg = 1./ilamg(k) - do n = 1, nrbins - x = xam_g * xxDg(n)**xbm_g - call rayleigh_soak_wetgraupel (x,DBLE(xocmg),DBLE(xobmg), & - fmelt_g, melt_outside_g, m_w_0, m_i_0, lamda_radar, & - CBACK, mixingrulestring_g, matrixstring_g, & - inclusionstring_g, hoststring_g, & - hostmatrixstring_g, hostinclusionstring_g) - f_d = N0_g(k)*xxDg(n)**xmu_g * DEXP(-lamg*xxDg(n)) - eta = eta + f_d * CBACK * simpson(n) * xdtg(n) - enddo - ze_graupel(k) = SNGL(lamda4 / (pi5 * K_w) * eta) - endif - - enddo - endif - - do k = kte, kts, -1 - dBZ(k) = 10.*log10((ze_rain(k)+ze_snow(k)+ze_graupel(k))*1.d18) - enddo - - - end subroutine refl10cm_gfdl -!+---+-----------------------------------------------------------------+ - -end module gfdl_cloud_microphys_mod diff --git a/src/dynamics/fv3/microphys/module_mp_radar.F90 b/src/dynamics/fv3/microphys/module_mp_radar.F90 deleted file mode 100644 index 8a16c98260..0000000000 --- a/src/dynamics/fv3/microphys/module_mp_radar.F90 +++ /dev/null @@ -1,614 +0,0 @@ -!+---+-----------------------------------------------------------------+ -!..This set of routines facilitates computing radar reflectivity. -!.. This module is more library code whereas the individual microphysics -!.. schemes contains specific details needed for the final computation, -!.. so refer to location within each schemes calling the routine named -!.. rayleigh_soak_wetgraupel. -!.. The bulk of this code originated from Ulrich Blahak (Germany) and -!.. was adapted to WRF by G. Thompson. This version of code is only -!.. intended for use when Rayleigh scattering principles dominate and -!.. is not intended for wavelengths in which Mie scattering is a -!.. significant portion. Therefore, it is well-suited to use with -!.. 5 or 10 cm wavelength like USA NEXRAD radars. -!.. This code makes some rather simple assumptions about water -!.. coating on outside of frozen species (snow/graupel). Fraction of -!.. meltwater is simply the ratio of mixing ratio below melting level -!.. divided by mixing ratio at level just above highest T>0C. Also, -!.. immediately 90% of the melted water exists on the ice's surface -!.. and 10% is embedded within ice. No water is "shed" at all in these -!.. assumptions. The code is quite slow because it does the reflectivity -!.. calculations based on 50 individual size bins of the distributions. -!+---+-----------------------------------------------------------------+ - - MODULE module_mp_radar - - PUBLIC :: rayleigh_soak_wetgraupel - PUBLIC :: radar_init - PRIVATE :: m_complex_water_ray - PRIVATE :: m_complex_ice_maetzler - PRIVATE :: m_complex_maxwellgarnett - PRIVATE :: get_m_mix_nested - PRIVATE :: get_m_mix - PRIVATE :: WGAMMA - PRIVATE :: GAMMLN - - - INTEGER, PARAMETER, PUBLIC:: nrbins = 50 - DOUBLE PRECISION, DIMENSION(nrbins+1), PUBLIC:: xxDx - DOUBLE PRECISION, DIMENSION(nrbins), PUBLIC:: xxDs,xdts,xxDg,xdtg - DOUBLE PRECISION, PARAMETER, PUBLIC:: lamda_radar = 0.10 ! in meters - DOUBLE PRECISION, PUBLIC:: K_w, PI5, lamda4 - COMPLEX*16, PUBLIC:: m_w_0, m_i_0 - DOUBLE PRECISION, DIMENSION(nrbins+1), PUBLIC:: simpson - DOUBLE PRECISION, DIMENSION(3), PARAMETER, PUBLIC:: basis = & - (/1.d0/3.d0, 4.d0/3.d0, 1.d0/3.d0/) - REAL, DIMENSION(4), PUBLIC:: xcre, xcse, xcge, xcrg, xcsg, xcgg - REAL, PUBLIC:: xam_r, xbm_r, xmu_r, xobmr - REAL, PUBLIC:: xam_s, xbm_s, xmu_s, xoams, xobms, xocms - REAL, PUBLIC:: xam_g, xbm_g, xmu_g, xoamg, xobmg, xocmg - REAL, PUBLIC:: xorg2, xosg2, xogg2 - - INTEGER, PARAMETER, PUBLIC:: slen = 20 - CHARACTER(len=slen), PUBLIC:: & - mixingrulestring_s, matrixstring_s, inclusionstring_s, & - hoststring_s, hostmatrixstring_s, hostinclusionstring_s, & - mixingrulestring_g, matrixstring_g, inclusionstring_g, & - hoststring_g, hostmatrixstring_g, hostinclusionstring_g - -!..Single melting snow/graupel particle 90% meltwater on external sfc - DOUBLE PRECISION, PARAMETER:: melt_outside_s = 0.9d0 - DOUBLE PRECISION, PARAMETER:: melt_outside_g = 0.9d0 - - CHARACTER*256:: radar_debug - - CONTAINS - -!+---+-----------------------------------------------------------------+ -!+---+-----------------------------------------------------------------+ -!+---+-----------------------------------------------------------------+ - - subroutine radar_init - - IMPLICIT NONE - INTEGER:: n - PI5 = 3.14159*3.14159*3.14159*3.14159*3.14159 - lamda4 = lamda_radar*lamda_radar*lamda_radar*lamda_radar - m_w_0 = m_complex_water_ray (lamda_radar, 0.0d0) - m_i_0 = m_complex_ice_maetzler (lamda_radar, 0.0d0) - K_w = (ABS( (m_w_0*m_w_0 - 1.0) /(m_w_0*m_w_0 + 2.0) ))**2 - - do n = 1, nrbins+1 - simpson(n) = 0.0d0 - enddo - do n = 1, nrbins-1, 2 - simpson(n) = simpson(n) + basis(1) - simpson(n+1) = simpson(n+1) + basis(2) - simpson(n+2) = simpson(n+2) + basis(3) - enddo - - do n = 1, slen - mixingrulestring_s(n:n) = char(0) - matrixstring_s(n:n) = char(0) - inclusionstring_s(n:n) = char(0) - hoststring_s(n:n) = char(0) - hostmatrixstring_s(n:n) = char(0) - hostinclusionstring_s(n:n) = char(0) - mixingrulestring_g(n:n) = char(0) - matrixstring_g(n:n) = char(0) - inclusionstring_g(n:n) = char(0) - hoststring_g(n:n) = char(0) - hostmatrixstring_g(n:n) = char(0) - hostinclusionstring_g(n:n) = char(0) - enddo - - mixingrulestring_s = 'maxwellgarnett' - hoststring_s = 'air' - matrixstring_s = 'water' - inclusionstring_s = 'spheroidal' - hostmatrixstring_s = 'icewater' - hostinclusionstring_s = 'spheroidal' - - mixingrulestring_g = 'maxwellgarnett' - hoststring_g = 'air' - matrixstring_g = 'water' - inclusionstring_g = 'spheroidal' - hostmatrixstring_g = 'icewater' - hostinclusionstring_g = 'spheroidal' - -!..Create bins of snow (from 100 microns up to 2 cm). - xxDx(1) = 100.D-6 - xxDx(nrbins+1) = 0.02d0 - do n = 2, nrbins - xxDx(n) = DEXP(DFLOAT(n-1)/DFLOAT(nrbins) & - *DLOG(xxDx(nrbins+1)/xxDx(1)) +DLOG(xxDx(1))) - enddo - do n = 1, nrbins - xxDs(n) = DSQRT(xxDx(n)*xxDx(n+1)) - xdts(n) = xxDx(n+1) - xxDx(n) - enddo - -!..Create bins of graupel (from 100 microns up to 5 cm). - xxDx(1) = 100.D-6 - xxDx(nrbins+1) = 0.05d0 - do n = 2, nrbins - xxDx(n) = DEXP(DFLOAT(n-1)/DFLOAT(nrbins) & - *DLOG(xxDx(nrbins+1)/xxDx(1)) +DLOG(xxDx(1))) - enddo - do n = 1, nrbins - xxDg(n) = DSQRT(xxDx(n)*xxDx(n+1)) - xdtg(n) = xxDx(n+1) - xxDx(n) - enddo - - -!..The calling program must set the m(D) relations and gamma shape -!.. parameter mu for rain, snow, and graupel. Easily add other types -!.. based on the template here. For majority of schemes with simpler -!.. exponential number distribution, mu=0. - - xcre(1) = 1. + xbm_r - xcre(2) = 1. + xmu_r - xcre(3) = 1. + xbm_r + xmu_r - xcre(4) = 1. + 2.*xbm_r + xmu_r - do n = 1, 4 - xcrg(n) = WGAMMA(xcre(n)) - enddo - xorg2 = 1./xcrg(2) - - xcse(1) = 1. + xbm_s - xcse(2) = 1. + xmu_s - xcse(3) = 1. + xbm_s + xmu_s - xcse(4) = 1. + 2.*xbm_s + xmu_s - do n = 1, 4 - xcsg(n) = WGAMMA(xcse(n)) - enddo - xosg2 = 1./xcsg(2) - - xcge(1) = 1. + xbm_g - xcge(2) = 1. + xmu_g - xcge(3) = 1. + xbm_g + xmu_g - xcge(4) = 1. + 2.*xbm_g + xmu_g - do n = 1, 4 - xcgg(n) = WGAMMA(xcge(n)) - enddo - xogg2 = 1./xcgg(2) - - xobmr = 1./xbm_r - xoams = 1./xam_s - xobms = 1./xbm_s - xocms = xoams**xobms - xoamg = 1./xam_g - xobmg = 1./xbm_g - xocmg = xoamg**xobmg - - - end subroutine radar_init - -!+---+-----------------------------------------------------------------+ -!+---+-----------------------------------------------------------------+ - - COMPLEX*16 FUNCTION m_complex_water_ray(lambda,T) - -! Complex refractive Index of Water as function of Temperature T -! [deg C] and radar wavelength lambda [m]; valid for -! lambda in [0.001,1.0] m; T in [-10.0,30.0] deg C -! after Ray (1972) - - IMPLICIT NONE - DOUBLE PRECISION, INTENT(IN):: T,lambda - DOUBLE PRECISION:: epsinf,epss,epsr,epsi - DOUBLE PRECISION:: alpha,lambdas,sigma,nenner - COMPLEX*16, PARAMETER:: i = (0d0,1d0) - DOUBLE PRECISION, PARAMETER:: PIx=3.1415926535897932384626434d0 - - epsinf = 5.27137d0 + 0.02164740d0 * T - 0.00131198d0 * T*T - epss = 78.54d+0 * (1.0 - 4.579d-3 * (T - 25.0) & - + 1.190d-5 * (T - 25.0)*(T - 25.0) & - - 2.800d-8 * (T - 25.0)*(T - 25.0)*(T - 25.0)) - alpha = -16.8129d0/(T+273.16) + 0.0609265d0 - lambdas = 0.00033836d0 * exp(2513.98d0/(T+273.16)) * 1e-2 - - nenner = 1.d0+2.d0*(lambdas/lambda)**(1d0-alpha)*sin(alpha*PIx*0.5) & - + (lambdas/lambda)**(2d0-2d0*alpha) - epsr = epsinf + ((epss-epsinf) * ((lambdas/lambda)**(1d0-alpha) & - * sin(alpha*PIx*0.5)+1d0)) / nenner - epsi = ((epss-epsinf) * ((lambdas/lambda)**(1d0-alpha) & - * cos(alpha*PIx*0.5)+0d0)) / nenner & - + lambda*1.25664/1.88496 - - m_complex_water_ray = SQRT(CMPLX(epsr,-epsi)) - - END FUNCTION m_complex_water_ray - -!+---+-----------------------------------------------------------------+ - - COMPLEX*16 FUNCTION m_complex_ice_maetzler(lambda,T) - -! complex refractive index of ice as function of Temperature T -! [deg C] and radar wavelength lambda [m]; valid for -! lambda in [0.0001,30] m; T in [-250.0,0.0] C -! Original comment from the Matlab-routine of Prof. Maetzler: -! Function for calculating the relative permittivity of pure ice in -! the microwave region, according to C. Maetzler, "Microwave -! properties of ice and snow", in B. Schmitt et al. (eds.) Solar -! System Ices, Astrophys. and Space Sci. Library, Vol. 227, Kluwer -! Academic Publishers, Dordrecht, pp. 241-257 (1998). Input: -! TK = temperature (K), range 20 to 273.15 -! f = frequency in GHz, range 0.01 to 3000 - - IMPLICIT NONE - DOUBLE PRECISION, INTENT(IN):: T,lambda - DOUBLE PRECISION:: f,c,TK,B1,B2,b,deltabeta,betam,beta,theta,alfa - - c = 2.99d8 - TK = T + 273.16 - f = c / lambda * 1d-9 - - B1 = 0.0207 - B2 = 1.16d-11 - b = 335.0d0 - deltabeta = EXP(-10.02 + 0.0364*(TK-273.16)) - betam = (B1/TK) * ( EXP(b/TK) / ((EXP(b/TK)-1)**2) ) + B2*f*f - beta = betam + deltabeta - theta = 300. / TK - 1. - alfa = (0.00504d0 + 0.0062d0*theta) * EXP(-22.1d0*theta) - m_complex_ice_maetzler = 3.1884 + 9.1e-4*(TK-273.16) - m_complex_ice_maetzler = m_complex_ice_maetzler & - + CMPLX(0.0d0, (alfa/f + beta*f)) - m_complex_ice_maetzler = SQRT(CONJG(m_complex_ice_maetzler)) - - END FUNCTION m_complex_ice_maetzler - -!+---+-----------------------------------------------------------------+ - - subroutine rayleigh_soak_wetgraupel (x_g, a_geo, b_geo, fmelt, & - meltratio_outside, m_w, m_i, lambda, C_back, & - mixingrule,matrix,inclusion, & - host,hostmatrix,hostinclusion) - - IMPLICIT NONE - - DOUBLE PRECISION, INTENT(in):: x_g, a_geo, b_geo, fmelt, lambda, & - meltratio_outside - DOUBLE PRECISION, INTENT(out):: C_back - COMPLEX*16, INTENT(in):: m_w, m_i - CHARACTER(len=*), INTENT(in):: mixingrule, matrix, inclusion, & - host, hostmatrix, hostinclusion - - COMPLEX*16:: m_core, m_air - DOUBLE PRECISION:: D_large, D_g, rhog, x_w, xw_a, fm, fmgrenz, & - volg, vg, volair, volice, volwater, & - meltratio_outside_grenz, mra - INTEGER:: error - DOUBLE PRECISION, PARAMETER:: PIx=3.1415926535897932384626434d0 - -! refractive index of air: - m_air = (1.0d0,0.0d0) - -! Limiting the degree of melting --- for safety: - fm = DMAX1(DMIN1(fmelt, 1.0d0), 0.0d0) -! Limiting the ratio of (melting on outside)/(melting on inside): - mra = DMAX1(DMIN1(meltratio_outside, 1.0d0), 0.0d0) - -! ! The relative portion of meltwater melting at outside should increase -! ! from the given input value (between 0 and 1) -! ! to 1 as the degree of melting approaches 1, -! ! so that the melting particle "converges" to a water drop. -! ! Simplest assumption is linear: - mra = mra + (1.0d0-mra)*fm - - x_w = x_g * fm - - D_g = a_geo * x_g**b_geo - - if (D_g .ge. 1d-12) then - - vg = PIx/6. * D_g**3 - rhog = DMAX1(DMIN1(x_g / vg, 900.0d0), 10.0d0) - vg = x_g / rhog - - meltratio_outside_grenz = 1.0d0 - rhog / 1000. - - if (mra .le. meltratio_outside_grenz) then - !..In this case, it cannot happen that, during melting, all the - !.. air inclusions within the ice particle get filled with - !.. meltwater. This only happens at the end of all melting. - volg = vg * (1.0d0 - mra * fm) - - else - !..In this case, at some melting degree fm, all the air - !.. inclusions get filled with meltwater. - fmgrenz=(900.0-rhog)/(mra*900.0-rhog+900.0*rhog/1000.) - - if (fm .le. fmgrenz) then - !.. not all air pockets are filled: - volg = (1.0 - mra * fm) * vg - else - !..all air pockets are filled with meltwater, now the - !.. entire ice sceleton melts homogeneously: - volg = (x_g - x_w) / 900.0 + x_w / 1000. - endif - - endif - - D_large = (6.0 / PIx * volg) ** (1./3.) - volice = (x_g - x_w) / (volg * 900.0) - volwater = x_w / (1000. * volg) - volair = 1.0 - volice - volwater - - !..complex index of refraction for the ice-air-water mixture - !.. of the particle: - m_core = get_m_mix_nested (m_air, m_i, m_w, volair, volice, & - volwater, mixingrule, host, matrix, inclusion, & - hostmatrix, hostinclusion, error) - if (error .ne. 0) then - C_back = 0.0d0 - return - endif - - !..Rayleigh-backscattering coefficient of melting particle: - C_back = (ABS((m_core**2-1.0d0)/(m_core**2+2.0d0)))**2 & - * PI5 * D_large**6 / lamda4 - - else - C_back = 0.0d0 - endif - - end subroutine rayleigh_soak_wetgraupel - -!+---+-----------------------------------------------------------------+ - - complex*16 function get_m_mix_nested (m_a, m_i, m_w, volair, & - volice, volwater, mixingrule, host, matrix, & - inclusion, hostmatrix, hostinclusion, cumulerror) - - IMPLICIT NONE - - DOUBLE PRECISION, INTENT(in):: volice, volair, volwater - COMPLEX*16, INTENT(in):: m_a, m_i, m_w - CHARACTER(len=*), INTENT(in):: mixingrule, host, matrix, & - inclusion, hostmatrix, hostinclusion - INTEGER, INTENT(out):: cumulerror - - DOUBLE PRECISION:: vol1, vol2 - COMPLEX*16:: mtmp - INTEGER:: error - - !..Folded: ( (m1 + m2) + m3), where m1,m2,m3 could each be - !.. air, ice, or water - - cumulerror = 0 - get_m_mix_nested = CMPLX(1.0d0,0.0d0) - - if (host .eq. 'air') then - - if (matrix .eq. 'air') then - write(*,*) 'GET_M_MIX_NESTED: bad matrix: ', matrix - cumulerror = cumulerror + 1 - else - vol1 = volice / MAX(volice+volwater,1d-10) - vol2 = 1.0d0 - vol1 - mtmp = get_m_mix (m_a, m_i, m_w, 0.0d0, vol1, vol2, & - mixingrule, matrix, inclusion, error) - cumulerror = cumulerror + error - - if (hostmatrix .eq. 'air') then - get_m_mix_nested = get_m_mix (m_a, mtmp, 2.0*m_a, & - volair, (1.0d0-volair), 0.0d0, mixingrule, & - hostmatrix, hostinclusion, error) - cumulerror = cumulerror + error - elseif (hostmatrix .eq. 'icewater') then - get_m_mix_nested = get_m_mix (m_a, mtmp, 2.0*m_a, & - volair, (1.0d0-volair), 0.0d0, mixingrule, & - 'ice', hostinclusion, error) - cumulerror = cumulerror + error - else - write(*,*) 'GET_M_MIX_NESTED: bad hostmatrix: ', & - hostmatrix - cumulerror = cumulerror + 1 - endif - endif - - elseif (host .eq. 'ice') then - - if (matrix .eq. 'ice') then - write(radar_debug,*) 'GET_M_MIX_NESTED: bad matrix: ', matrix - cumulerror = cumulerror + 1 - else - vol1 = volair / MAX(volair+volwater,1d-10) - vol2 = 1.0d0 - vol1 - mtmp = get_m_mix (m_a, m_i, m_w, vol1, 0.0d0, vol2, & - mixingrule, matrix, inclusion, error) - cumulerror = cumulerror + error - - if (hostmatrix .eq. 'ice') then - get_m_mix_nested = get_m_mix (mtmp, m_i, 2.0*m_a, & - (1.0d0-volice), volice, 0.0d0, mixingrule, & - hostmatrix, hostinclusion, error) - cumulerror = cumulerror + error - elseif (hostmatrix .eq. 'airwater') then - get_m_mix_nested = get_m_mix (mtmp, m_i, 2.0*m_a, & - (1.0d0-volice), volice, 0.0d0, mixingrule, & - 'air', hostinclusion, error) - cumulerror = cumulerror + error - else - write(*,*) 'GET_M_MIX_NESTED: bad hostmatrix: ', & - hostmatrix - cumulerror = cumulerror + 1 - endif - endif - - elseif (host .eq. 'water') then - - if (matrix .eq. 'water') then - write(*,*) 'GET_M_MIX_NESTED: bad matrix: ', matrix - cumulerror = cumulerror + 1 - else - vol1 = volair / MAX(volice+volair,1d-10) - vol2 = 1.0d0 - vol1 - mtmp = get_m_mix (m_a, m_i, m_w, vol1, vol2, 0.0d0, & - mixingrule, matrix, inclusion, error) - cumulerror = cumulerror + error - - if (hostmatrix .eq. 'water') then - get_m_mix_nested = get_m_mix (2*m_a, mtmp, m_w, & - 0.0d0, (1.0d0-volwater), volwater, mixingrule, & - hostmatrix, hostinclusion, error) - cumulerror = cumulerror + error - elseif (hostmatrix .eq. 'airice') then - get_m_mix_nested = get_m_mix (2*m_a, mtmp, m_w, & - 0.0d0, (1.0d0-volwater), volwater, mixingrule, & - 'ice', hostinclusion, error) - cumulerror = cumulerror + error - else - write(*,*) 'GET_M_MIX_NESTED: bad hostmatrix: ', & - hostmatrix - cumulerror = cumulerror + 1 - endif - endif - - elseif (host .eq. 'none') then - - get_m_mix_nested = get_m_mix (m_a, m_i, m_w, & - volair, volice, volwater, mixingrule, & - matrix, inclusion, error) - cumulerror = cumulerror + error - - else - write(*,*) 'GET_M_MIX_NESTED: unknown matrix: ', host - cumulerror = cumulerror + 1 - endif - - IF (cumulerror .ne. 0) THEN - write(*,*) 'GET_M_MIX_NESTED: error encountered' - get_m_mix_nested = CMPLX(1.0d0,0.0d0) - endif - - end function get_m_mix_nested - -!+---+-----------------------------------------------------------------+ - - COMPLEX*16 FUNCTION get_m_mix (m_a, m_i, m_w, volair, volice, & - volwater, mixingrule, matrix, inclusion, error) - - IMPLICIT NONE - - DOUBLE PRECISION, INTENT(in):: volice, volair, volwater - COMPLEX*16, INTENT(in):: m_a, m_i, m_w - CHARACTER(len=*), INTENT(in):: mixingrule, matrix, inclusion - INTEGER, INTENT(out):: error - - error = 0 - get_m_mix = CMPLX(1.0d0,0.0d0) - - if (mixingrule .eq. 'maxwellgarnett') then - if (matrix .eq. 'ice') then - get_m_mix = m_complex_maxwellgarnett(volice, volair, volwater, & - m_i, m_a, m_w, inclusion, error) - elseif (matrix .eq. 'water') then - get_m_mix = m_complex_maxwellgarnett(volwater, volair, volice, & - m_w, m_a, m_i, inclusion, error) - elseif (matrix .eq. 'air') then - get_m_mix = m_complex_maxwellgarnett(volair, volwater, volice, & - m_a, m_w, m_i, inclusion, error) - else - write(*,*) 'GET_M_MIX: unknown matrix: ', matrix - error = 1 - endif - - else - write(*,*) 'GET_M_MIX: unknown mixingrule: ', mixingrule - error = 2 - endif - - if (error .ne. 0) then - write(*,*) 'GET_M_MIX: error encountered' - endif - - END FUNCTION get_m_mix - -!+---+-----------------------------------------------------------------+ - - COMPLEX*16 FUNCTION m_complex_maxwellgarnett(vol1, vol2, vol3, & - m1, m2, m3, inclusion, error) - - IMPLICIT NONE - - COMPLEX*16 :: m1, m2, m3 - DOUBLE PRECISION :: vol1, vol2, vol3 - CHARACTER(len=*) :: inclusion - - COMPLEX*16 :: beta2, beta3, m1t, m2t, m3t - INTEGER, INTENT(out) :: error - - error = 0 - - if (DABS(vol1+vol2+vol3-1.0d0) .gt. 1d-6) then - write(*,*) 'M_COMPLEX_MAXWELLGARNETT: sum of the ', & - 'partial volume fractions is not 1...ERROR' - m_complex_maxwellgarnett=CMPLX(-999.99d0,-999.99d0) - error = 1 - return - endif - - m1t = m1**2 - m2t = m2**2 - m3t = m3**2 - - if (inclusion .eq. 'spherical') then - beta2 = 3.0d0*m1t/(m2t+2.0d0*m1t) - beta3 = 3.0d0*m1t/(m3t+2.0d0*m1t) - elseif (inclusion .eq. 'spheroidal') then - beta2 = 2.0d0*m1t/(m2t-m1t) * (m2t/(m2t-m1t)*LOG(m2t/m1t)-1.0d0) - beta3 = 2.0d0*m1t/(m3t-m1t) * (m3t/(m3t-m1t)*LOG(m3t/m1t)-1.0d0) - else - write(*,*) 'M_COMPLEX_MAXWELLGARNETT: ', & - 'unknown inclusion: ', inclusion - m_complex_maxwellgarnett=DCMPLX(-999.99d0,-999.99d0) - error = 1 - return - endif - - m_complex_maxwellgarnett = & - SQRT(((1.0d0-vol2-vol3)*m1t + vol2*beta2*m2t + vol3*beta3*m3t) / & - (1.0d0-vol2-vol3+vol2*beta2+vol3*beta3)) - - END FUNCTION m_complex_maxwellgarnett - -!+---+-----------------------------------------------------------------+ - REAL FUNCTION GAMMLN(XX) -! --- RETURNS THE VALUE LN(GAMMA(XX)) FOR XX > 0. - IMPLICIT NONE - REAL, INTENT(IN):: XX - DOUBLE PRECISION, PARAMETER:: STP = 2.5066282746310005D0 - DOUBLE PRECISION, DIMENSION(6), PARAMETER:: & - COF = (/76.18009172947146D0, -86.50532032941677D0, & - 24.01409824083091D0, -1.231739572450155D0, & - .1208650973866179D-2, -.5395239384953D-5/) - DOUBLE PRECISION:: SER,TMP,X,Y - INTEGER:: J - - X=XX - Y=X - TMP=X+5.5D0 - TMP=(X+0.5D0)*LOG(TMP)-TMP - SER=1.000000000190015D0 - DO 11 J=1,6 - Y=Y+1.D0 - SER=SER+COF(J)/Y -11 CONTINUE - GAMMLN=TMP+LOG(STP*SER/X) - END FUNCTION GAMMLN -! (C) Copr. 1986-92 Numerical Recipes Software 2.02 -!+---+-----------------------------------------------------------------+ - REAL FUNCTION WGAMMA(y) - - IMPLICIT NONE - REAL, INTENT(IN):: y - - WGAMMA = EXP(GAMMLN(y)) - - END FUNCTION WGAMMA - -!+---+-----------------------------------------------------------------+ - END MODULE module_mp_radar -!+---+-----------------------------------------------------------------+ diff --git a/src/dynamics/fv3/pmgrid.F90 b/src/dynamics/fv3/pmgrid.F90 deleted file mode 100644 index fff3dbce18..0000000000 --- a/src/dynamics/fv3/pmgrid.F90 +++ /dev/null @@ -1,15 +0,0 @@ -module pmgrid - -! PLON and PLAT do not correspond to the number of latitudes and longitudes in -! this version of dynamics. - -implicit none -save - -integer, parameter :: plev = PLEV ! number of vertical levels -integer, parameter :: plevp = plev + 1 - -integer, parameter :: plon = 1 -integer, parameter :: plat = 1 - -end module pmgrid diff --git a/src/dynamics/fv3/restart_dynamics.F90 b/src/dynamics/fv3/restart_dynamics.F90 deleted file mode 100644 index 8679f30c95..0000000000 --- a/src/dynamics/fv3/restart_dynamics.F90 +++ /dev/null @@ -1,447 +0,0 @@ -module restart_dynamics - -! Write and read dynamics fields from the restart file. For exact restart -! it is necessary to write all element data, including duplicate columns, -! to the file. - - use cam_abortutils, only: endrun - use cam_grid_support, only: cam_grid_header_info_t, cam_grid_id, cam_grid_write_attr, & - cam_grid_write_var, cam_grid_get_decomp, cam_grid_dimensions, max_hcoordname_len - use cam_logfile, only: iulog - use cam_pio_utils, only: cam_pio_handle_error - use dyn_comp, only: dyn_import_t, dyn_export_t - use dyn_grid, only: mytile - use fv_arrays_mod, only: fv_atmos_type - use pio, only: file_desc_t, var_desc_t - use shr_kind_mod, only: r8 => shr_kind_r8, i8 => shr_kind_i8 - use spmd_utils, only: masterproc - - implicit none - private - - public :: init_restart_dynamics, write_restart_dynamics, read_restart_dynamics - - type(var_desc_t) :: udesc, vdesc, tdesc, psdesc, phisdesc, usdesc,vsdesc,delpdesc,omegadesc - - integer :: ncol_d_dimid, ncol_d_ew_dimid, ncol_d_ns_dimid, nlev_dimid, nlevp_dimid - type(var_desc_t), allocatable :: qdesc(:) - integer :: is,ie,js,je - - -!======================================================================= -contains -!======================================================================= - -subroutine init_restart_dynamics(File, dyn_out) - - use constituents, only: cnst_name, pcnst - use hycoef, only: init_restart_hycoef - use pio, only: pio_unlimited, pio_double, pio_def_dim, & - pio_seterrorhandling, pio_bcast_error, & - pio_def_var, & - pio_inq_dimid - - ! arguments - type(file_desc_t), intent(inout) :: file - type(dyn_export_t), intent(in) :: dyn_out - - ! local variables - integer :: vdimids(2) - integer :: ierr, i, err_handling - integer :: time_dimid - integer :: is,ie,js,je - type (fv_atmos_type), pointer :: Atm(:) - - integer :: grid_id,grid_id_ns,grid_id_ew - type(cam_grid_header_info_t) :: info,info_ew,info_ns - - !--------------------------------------------------------------------------- - - Atm=>dyn_out%atm - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - - call init_restart_hycoef(File, vdimids) - - call pio_seterrorhandling(File, pio_bcast_error, err_handling) - - ierr = PIO_Def_Dim(File, 'time', PIO_UNLIMITED, time_dimid) - - grid_id = cam_grid_id('FFSL') - call cam_grid_write_attr(File, grid_id, info) - ncol_d_dimid = info%get_hdimid(1) - - grid_id_ew = cam_grid_id('FFSL_EW') - call cam_grid_write_attr(File, grid_id_ew, info_ew) - ncol_d_ew_dimid = info_ew%get_hdimid(1) - - grid_id_ns = cam_grid_id('FFSL_NS') - call cam_grid_write_attr(File, grid_id_ns, info_ns) - ncol_d_ns_dimid = info_ns%get_hdimid(1) - - nlev_dimid = vdimids(1) - - ierr = PIO_Def_Var(File, 'U', pio_double, (/ncol_d_dimid, nlev_dimid/), Udesc) - ierr = PIO_Def_Var(File, 'V', pio_double, (/ncol_d_dimid, nlev_dimid/), Vdesc) - ierr = PIO_Def_Var(File, 'US', pio_double, (/ncol_d_ns_dimid, nlev_dimid/), USdesc) - ierr = PIO_Def_Var(File, 'VS', pio_double, (/ncol_d_ew_dimid, nlev_dimid/), VSdesc) - ierr = PIO_Def_Var(File, 'T', pio_double, (/ncol_d_dimid, nlev_dimid/), Tdesc) - ierr = PIO_Def_Var(File, 'OMEGA', pio_double, (/ncol_d_dimid, nlev_dimid/), omegadesc) - ierr = PIO_Def_Var(File, 'DELP', pio_double, (/ncol_d_dimid, nlev_dimid/), delpdesc) - ierr = PIO_Def_Var(File, 'PS', pio_double, (/ncol_d_dimid/), PSdesc) - ierr = PIO_Def_Var(File, 'PHIS', pio_double, (/ncol_d_dimid/), phisdesc) - - allocate(Qdesc(pcnst)) - - do i = 1, pcnst - ierr = PIO_Def_Var(File, cnst_name(i), pio_double, (/ncol_d_dimid, nlev_dimid/), Qdesc(i)) - end do - - call pio_seterrorhandling(File, err_handling) - -end subroutine init_restart_dynamics - -!======================================================================= - -subroutine write_restart_dynamics(File, dyn_out) - - use hycoef, only: write_restart_hycoef - use constituents, only: pcnst - use dimensions_mod, only: nlev - use pio, only: pio_offset_kind, io_desc_t, pio_double, pio_write_darray - use time_manager, only: get_curr_time, get_curr_date - - ! arguments - type(file_desc_t), intent(inout) :: File - type(dyn_export_t), intent(in) :: dyn_out - - ! local variables - integer(pio_offset_kind), parameter :: t_idx = 1 - type (fv_atmos_type), pointer :: Atm(:) - - type(io_desc_t),pointer :: iodesc3d,iodesc3d_ns,iodesc3d_ew,iodesc - integer :: m, ierr - integer :: array_lens_3d(3), array_lens_2d(2) - integer :: file_lens_2d(2), file_lens_1d(1) - integer :: grid_id,grid_id_ns,grid_id_ew - integer :: grid_dimlens(2),grid_dimlens_ew(2),grid_dimlens_ns(2) - integer :: ilen,jlen - - !--------------------------------------------------------------------------- - - call write_restart_hycoef(File) - - Atm=>dyn_out%atm - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - - grid_id = cam_grid_id('FFSL') - grid_id_ew = cam_grid_id('FFSL_EW') - grid_id_ns = cam_grid_id('FFSL_NS') - - ! write coordinate variables for unstructured FFSL, NS and EW restart grid - ! (restart grids have tile based global indicies with duplicate edge points - ! being given uniq indicies. All duplicate point written out to restart file) - ! - io overhead = 6 tile edges are duplicated and read from the file - ! instead of mpi gathers to fill in duplicates. - - call cam_grid_write_var(File, grid_id) - call cam_grid_write_var(File, grid_id_ew) - call cam_grid_write_var(File, grid_id_ns) - - ! create map for distributed write - call cam_grid_dimensions(grid_id, grid_dimlens) - call cam_grid_dimensions(grid_id_ew, grid_dimlens_ew) - call cam_grid_dimensions(grid_id_ns, grid_dimlens_ns) - - ilen=ie-is+1 - jlen=je-js+1 - - ! create map for distributed write of 2D fields - array_lens_2d = (/ilen,jlen/) - file_lens_1d = (/grid_dimlens(1)/) - call cam_grid_get_decomp(grid_id, array_lens_2d, file_lens_1d, pio_double, iodesc) - ! Write PHIS - call PIO_Write_Darray(File, phisdesc, iodesc, Atm(mytile)%phis(is:ie,js:je), ierr) - ! Write PS - call PIO_Write_Darray(File, psdesc, iodesc, Atm(mytile)%ps(is:ie,js:je), ierr) - - array_lens_3d = (/ilen,jlen,nlev/) - file_lens_2d = (/grid_dimlens(1), nlev/) - call cam_grid_get_decomp(grid_id, array_lens_3d, file_lens_2d, pio_double, iodesc3d) - ! Write U a-grid - call PIO_Write_Darray(File, Udesc, iodesc3d, Atm(mytile)%ua(is:ie,js:je,1:nlev), ierr) - ! Write V a-grid - call PIO_Write_Darray(File, Vdesc, iodesc3d, Atm(mytile)%va(is:ie,js:je,1:nlev) , ierr) - ! Write OMEGA a-grid - call PIO_Write_Darray(File, Omegadesc, iodesc3d, Atm(mytile)%omga(is:ie,js:je,1:nlev), ierr) - ! Write DELP a-grid - call PIO_Write_Darray(File, delpdesc, iodesc3d, Atm(mytile)%delp(is:ie,js:je,1:nlev), ierr) - ! Write PT a-grid - call PIO_Write_Darray(File, Tdesc, iodesc3d, Atm(mytile)%pt(is:ie,js:je,1:nlev), ierr) - ! Write Tracers a-grid - do m = 1, pcnst - call PIO_Write_Darray(File, Qdesc(m), iodesc3d, Atm(mytile)%q(is:ie,js:je,1:nlev,m), ierr) - end do - - deallocate(qdesc) - - ! create map for distributed write of 3D NS fields - array_lens_3d = (/ilen ,(jlen+1), nlev/) - file_lens_2d = (/grid_dimlens_ns(1), nlev/) - call cam_grid_get_decomp(grid_id_ns, array_lens_3d, file_lens_2d, pio_double, iodesc3d_ns) - - !WRITE US - call PIO_Write_Darray(File, USdesc, iodesc3d_ns, Atm(mytile)%u(is:ie,js:je+1,1:nlev), ierr) - - ! create map for distributed write of 3D EW fields - array_lens_3d = (/(ilen+1), jlen, nlev /) - file_lens_2d = (/grid_dimlens_ew(1), nlev/) - call cam_grid_get_decomp(grid_id_ew, array_lens_3d, file_lens_2d, pio_double, iodesc3d_ew) - - !WRITE VS - call PIO_Write_Darray(File, VSdesc, iodesc3d_ew, Atm(mytile)%v(is:ie+1,js:je,1:nlev), ierr) - -end subroutine write_restart_dynamics - -!======================================================================= - -subroutine read_restart_dynamics(File, dyn_in, dyn_out) - - use cam_history_support, only: max_fieldname_len - use constituents, only: cnst_name, pcnst - use dimensions_mod,only: npy,npx,nlev - use dyn_comp, only: dyn_init - use dyn_grid, only: Atm - use mpp_domains_mod, only: mpp_update_domains, DGRID_NE, mpp_get_boundary - use pio, only: file_desc_t, pio_double, & - pio_inq_dimid, pio_inq_dimlen, pio_inq_varid, & - pio_read_darray, file_desc_t, io_desc_t, pio_double,pio_offset_kind,& - pio_seterrorhandling, pio_bcast_error - - ! arguments - type(File_desc_t), intent(inout) :: File - type(dyn_import_t), intent(out) :: dyn_in - type(dyn_export_t), intent(out) :: dyn_out - - ! local variables - integer(pio_offset_kind), parameter :: t_idx = 1 - - integer :: tl - integer :: i, k, m, j - integer :: ierr, err_handling - integer :: fnlev - integer :: ncols_d_ns, ncols_d_ew, ncols_d - - integer :: ncol_d_dimid - integer :: ncol_d_ns_dimid - integer :: ncol_d_ew_dimid - - type(var_desc_t) :: omegadesc - type(var_desc_t) :: delpdesc - type(var_desc_t) :: udesc - type(var_desc_t) :: vdesc - type(var_desc_t) :: usdesc - type(var_desc_t) :: vsdesc - type(var_desc_t) :: tdesc - type(var_desc_t) :: psdesc - type(var_desc_t) :: phisdesc - type(var_desc_t), allocatable :: qdesc(:) - type(io_desc_t),pointer :: iodesc2d, iodesc3d,iodesc3d_ns,iodesc3d_ew - integer :: array_lens_3d(3), array_lens_2d(2) - integer :: file_lens_2d(2), file_lens_1d(1) - integer :: grid_id,grid_id_ns,grid_id_ew,ilen,jlen - integer :: grid_dimlens(2),grid_dimlens_ns(2),grid_dimlens_ew(2) - - real(r8), allocatable :: ebuffer(:,:) - real(r8), allocatable :: nbuffer(:,:) - - character(len=*), parameter :: sub = 'read_restart_dynamics' - character(len=256) :: errormsg - !---------------------------------------------------------------------------- - - ! Note1: the hybrid coefficients are read from the same location as for an - ! initial run (e.g., dyn_grid_init). - - ! Note2: the dyn_in and dyn_out objects are not associated with the Atm dynamics - ! object until dyn_init is called. Until the restart is better integrated - ! into dyn_init we just access Atm directly from the dyn_grid - ! module. FV3 dyn_init calls an fv3 diagnostic init routine that tries to access - ! surface pressure in the Atm structure and at the top of read_restart PS hasn't - ! been read in yet. - - tl = 1 - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - - call pio_seterrorhandling(File, pio_bcast_error, err_handling) - - ierr = PIO_Inq_DimID(File, 'lev', nlev_dimid) - ierr = PIO_Inq_dimlen(File, nlev_dimid, fnlev) - if (nlev /= fnlev) then - write(errormsg, *) ': Restart file nlev dimension does not match model levels:',& - 'file nlev=',fnlev,', model nlev=',nlev - call endrun(sub//trim(errormsg)) - end if - - ! variable descriptors of required dynamics fields - ierr = PIO_Inq_varid(File, 'DELP', delpdesc) - call cam_pio_handle_error(ierr, sub//': cannot find DELP') - ierr = PIO_Inq_varid(File, 'OMEGA', omegadesc) - call cam_pio_handle_error(ierr, sub//': cannot find OMEGA') - ierr = PIO_Inq_varid(File, 'U', udesc) - call cam_pio_handle_error(ierr, sub//': cannot find UA') - ierr = PIO_Inq_varid(File, 'V', Vdesc) - call cam_pio_handle_error(ierr, sub//': cannot find VA') - ierr = PIO_Inq_varid(File, 'US', usdesc) - call cam_pio_handle_error(ierr, sub//': cannot find US') - ierr = PIO_Inq_varid(File, 'VS', Vsdesc) - call cam_pio_handle_error(ierr, sub//': cannot find VS') - ierr = PIO_Inq_varid(File, 'T', tdesc) - call cam_pio_handle_error(ierr, sub//': cannot find T') - ierr = PIO_Inq_varid(File, 'PS', psdesc) - call cam_pio_handle_error(ierr, sub//': cannot find PS') - ierr = PIO_Inq_varid(File, 'PHIS', phisdesc) - call cam_pio_handle_error(ierr, sub//': cannot find PHIS') - allocate(qdesc(pcnst)) - do m = 1, pcnst - ierr = PIO_Inq_varid(File, trim(cnst_name(m)), Qdesc(m)) - call cam_pio_handle_error(ierr, sub//': cannot find '//trim(cnst_name(m))) - end do - - ! check whether the restart fields on the GLL grid contain unique columns - ! or the fv3 task structure (ncol_d_ns = (ie-is+1)*(je-js+2)+npes columns) - ! or the fv3 task structure (ncol_d_ew = (ie-is+2)*(je-js+1)+npes columns) - - ierr = PIO_Inq_DimID(File, 'ncol_d', ncol_d_dimid) - call cam_pio_handle_error(ierr, sub//': cannot find ncol_d') - ierr = PIO_Inq_dimlen(File, ncol_d_dimid, ncols_d) - - ierr = PIO_Inq_DimID(File, 'ncol_d_ns', ncol_d_ns_dimid) - call cam_pio_handle_error(ierr, sub//': cannot find ncol_d_ns') - ierr = PIO_Inq_dimlen(File, ncol_d_ns_dimid, ncols_d_ns) - - ierr = PIO_Inq_DimID(File, 'ncol_d_ew', ncol_d_ew_dimid) - call cam_pio_handle_error(ierr, sub//': cannot find ncol_d_ew') - ierr = PIO_Inq_dimlen(File, ncol_d_ew_dimid, ncols_d_ew) - - grid_id = cam_grid_id('FFSL') - grid_id_ns = cam_grid_id('FFSL_NS') - grid_id_ew = cam_grid_id('FFSL_EW') - call cam_grid_dimensions(grid_id, grid_dimlens) - call cam_grid_dimensions(grid_id_ew, grid_dimlens_ew) - call cam_grid_dimensions(grid_id_ns, grid_dimlens_ns) - - if (ncols_d /= grid_dimlens(1)) then - write(errormsg, *) ':Restart file ncol_d dimension does not match number of model A-Grid columns',& - 'Restart ncols_d=',ncols_d,', A-Grid ncols=',grid_dimlens(1) - call endrun(sub//trim(errormsg)) - end if - - if (ncols_d_ns /= grid_dimlens_ns(1)) then - write(errormsg, *) ':Restart file ncol_d dimension does not match number of model D-Grid ns columns',& - 'Restart ncols_d_ns=',ncols_d_ns,', D-Grid ns ncols=',grid_dimlens_ns(1) - call endrun(sub//trim(errormsg)) - end if - - if (ncols_d_ew /= grid_dimlens_ew(1)) then - write(errormsg, *) ':Restart file ncol_d dimension does not match number of model D-Grid ew columns',& - 'Restart ncols_d_ew=',ncols_d_ew,', D-Grid ew ncols=',grid_dimlens_ew(1) - call endrun(sub//trim(errormsg)) - end if - - ilen = ie-is+1 - jlen = je-js+1 - ! create map for distributed write of 2D fields - array_lens_2d = (/ilen,jlen/) - file_lens_1d = (/grid_dimlens(1)/) - call cam_grid_get_decomp(grid_id, array_lens_2d, file_lens_1d, pio_double, iodesc2d) - - ! create map for distributed write of 3D fields - array_lens_3d = (/ilen, jlen,nlev/) - file_lens_2d = (/grid_dimlens(1), nlev/) - call cam_grid_get_decomp(grid_id, array_lens_3d, file_lens_2d, pio_double, iodesc3d) - - ! create map for distributed write of 3D NS fields - array_lens_3d = (/ilen, jlen+1, nlev/) - file_lens_2d = (/grid_dimlens_ns(1), nlev/) - call cam_grid_get_decomp(grid_id_ns, array_lens_3d, file_lens_2d, pio_double, iodesc3d_ns) - - ! create map for distributed write of 3D EW fields - array_lens_3d = (/ilen+1, jlen, nlev/) - file_lens_2d = (/grid_dimlens_ew(1), nlev/) - call cam_grid_get_decomp(grid_id_ew, array_lens_3d, file_lens_2d, pio_double, iodesc3d_ew) - - ! PS - call PIO_Read_Darray(File, psdesc, iodesc2d,atm(mytile)%ps(is:ie,js:je), ierr) - ! PHIS - call PIO_Read_Darray(File, phisdesc, iodesc2d, atm(mytile)%phis(is:ie,js:je), ierr) - ! OMEGA - call PIO_Read_Darray(File, omegadesc, iodesc3d,Atm(mytile)%omga(is:ie,js:je,1:nlev), ierr) - ! DELP - call PIO_Read_Darray(File, delpdesc, iodesc3d, atm(mytile)%delp(is:ie,js:je,1:nlev), ierr) - ! T - call PIO_Read_Darray(File, Tdesc, iodesc3d,atm(mytile)%pt(is:ie,js:je,1:nlev) , ierr) - ! V - call PIO_Read_Darray(File, Vdesc, iodesc3d, atm(mytile)%va(is:ie,js:je,1:nlev), ierr) - ! U - call PIO_Read_Darray(File, Udesc, iodesc3d, atm(mytile)%ua(is:ie,js:je,1:nlev), ierr) - ! tracers - do m = 1, pcnst - call PIO_Read_Darray(File, Qdesc(m), iodesc3d, atm(mytile)%q(is:ie,js:je,1:nlev,m), ierr) - end do - - deallocate(qdesc) - - ! US and VS After reading unique points on D grid call get_boundary routine to fill - ! missing points on the north and east block boundaries which are duplicated between - ! adjacent blocks. - - allocate(ebuffer(npy+2,nlev)) - allocate(nbuffer(npx+2,nlev)) - nbuffer = 0._r8 - ebuffer = 0._r8 - ! US - call PIO_Read_Darray(File, USdesc, iodesc3d_ns, atm(mytile)%u(is:ie,js:je+1,1:nlev), ierr) - ! VS - call PIO_Read_Darray(File, VSdesc, iodesc3d_ew, atm(mytile)%v(is:ie+1,js:je,1:nlev), ierr) - ! US/VS duplicates - call mpp_get_boundary(atm(mytile)%u, atm(mytile)%v, atm(mytile)%domain, ebuffery=ebuffer, & - nbufferx=nbuffer, gridtype=DGRID_NE ) - do k=1,nlev - do i=is,ie - atm(mytile)%u(i,je+1,k) = nbuffer(i-is+1,k) - enddo - do j=js,je - atm(mytile)%v(ie+1,j,k) = ebuffer(j-js+1,k) - enddo - enddo - deallocate(ebuffer) - deallocate(nbuffer) - - ! Update halo points on each processor - - call mpp_update_domains( Atm(mytile)%phis, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%ps, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%u,atm(mytile)%v, Atm(mytile)%domain, gridtype=DGRID_NE, complete=.true. ) - call mpp_update_domains( atm(mytile)%pt, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%delp, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%omga, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%q, Atm(mytile)%domain ) - - call dyn_init(dyn_in, dyn_out) - - call pio_seterrorhandling(File, err_handling) - - - end subroutine read_restart_dynamics - -end module restart_dynamics diff --git a/src/dynamics/fv3/spmd_dyn.F90 b/src/dynamics/fv3/spmd_dyn.F90 deleted file mode 100644 index d1634d7f9d..0000000000 --- a/src/dynamics/fv3/spmd_dyn.F90 +++ /dev/null @@ -1,18 +0,0 @@ -module spmd_dyn - - ! Purpose: SPMD implementation of CAM FV3 dynamics. - - implicit none - private - - ! These variables are not used locally, but are set and used in phys_grid. - ! They probably should be moved there. - logical, public :: local_dp_map=.true. ! flag indicates that mapping between dynamics - ! and physics decompositions does not require - ! interprocess communication - integer, public :: block_buf_nrecs ! number of local grid points (lon,lat,lev) - ! in dynamics decomposition (including level 0) - integer, public :: chunk_buf_nrecs ! number of local grid points (lon,lat,lev) - ! in physics decomposition (including level 0) - ! assigned in phys_grid.F90 -end module spmd_dyn diff --git a/src/dynamics/fv3/stepon.F90 b/src/dynamics/fv3/stepon.F90 deleted file mode 100644 index 3dea958877..0000000000 --- a/src/dynamics/fv3/stepon.F90 +++ /dev/null @@ -1,334 +0,0 @@ -module stepon - - ! MODULE: stepon -- FV3 Dynamics specific time-stepping - - use shr_kind_mod, only: r8 => shr_kind_r8 - use physics_types, only: physics_state, physics_tend - use ppgrid, only: begchunk, endchunk - use perf_mod, only: t_startf, t_stopf, t_barrierf - use spmd_utils, only: iam, masterproc, mpicom - use dyn_comp, only: dyn_import_t, dyn_export_t - use dyn_grid, only: mytile - use time_manager, only: get_step_size - use dimensions_mod, only: qsize_tracer_idx_cam2dyn - - use aerosol_properties_mod, only: aerosol_properties - use aerosol_state_mod, only: aerosol_state - use microp_aero, only: aerosol_state_object, aerosol_properties_object - - implicit none - private - - public stepon_init ! Initialization - public stepon_run1 ! run method phase 1 - public stepon_run2 ! run method phase 2 - public stepon_run3 ! run method phase 3 - public stepon_final ! Finalization - - class(aerosol_properties), pointer :: aero_props_obj => null() - logical :: aerosols_transported = .false. - -!======================================================================= -contains -!======================================================================= - -subroutine stepon_init(dyn_in, dyn_out) - - ! ROUTINE: stepon_init -- Time stepping initialization - - use cam_history, only: addfld, add_default, horiz_only - use constituents, only: pcnst, cnst_name, cnst_longname - - type (dyn_import_t), intent(inout) :: dyn_in ! Dynamics import container - type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container - - ! local variables - integer :: m_cnst,m_cnst_ffsl - !---------------------------------------------------------------------------- - ! These fields on dynamics grid are output before the call to d_p_coupling. - do m_cnst = 1, pcnst - m_cnst_ffsl=qsize_tracer_idx_cam2dyn(m_cnst) - call addfld(trim(cnst_name(m_cnst))//'_ffsl', (/ 'lev' /), 'I', 'kg/kg', & - trim(cnst_longname(m_cnst)), gridname='FFSLHIST') - call addfld(trim(cnst_name(m_cnst))//'_mass_ffsl', (/ 'lev' /), 'I', 'kg/kg', & - trim(cnst_longname(m_cnst))//'*dp', gridname='FFSLHIST') - end do - call addfld('U_ffsl' ,(/ 'lev' /), 'I', 'm/s ','U wind on A grid after dynamics',gridname='FFSLHIST') - call addfld('V_ffsl' ,(/ 'lev' /), 'I', 'm/s ','V wind on A grid after dynamics',gridname='FFSLHIST') - call addfld('U_ffsl_ns' ,(/ 'lev' /), 'I', 'm/s ','U wind on NS grid after dynamics',gridname='FFSLHIST_NS') - call addfld('V_ffsl_ew' ,(/ 'lev' /), 'I', 'm/s ','V wind on EW grid after dynamics',gridname='FFSLHIST_EW') - call addfld('T_ffsl' ,(/ 'lev' /), 'I', 'K ' ,'T on A grid grid after dynamics' ,gridname='FFSLHIST') - call addfld('PS_ffsl', horiz_only, 'I', 'Pa', 'Surface pressure on A grid after dynamics',gridname='FFSLHIST') - call addfld('PHIS_ffsl', horiz_only, 'I', 'Pa', 'Geopotential height on A grid after dynamics',gridname='FFSLHIST') - - - ! Fields for initial condition files - call addfld('U&IC', (/ 'lev' /), 'I', 'm/s', 'Zonal wind', gridname='FFSLHIST' ) - call addfld('V&IC', (/ 'lev' /), 'I', 'm/s', 'Meridional wind',gridname='FFSLHIST' ) - ! Don't need to register U&IC V&IC as vector components since we don't interpolate IC files - call add_default('U&IC',0, 'I') - call add_default('V&IC',0, 'I') - - call addfld('PS&IC', horiz_only, 'I', 'Pa', 'Surface pressure',gridname='FFSLHIST') - call addfld('PHIS&IC', horiz_only, 'I', 'Pa', 'PHIS on ffsl grid',gridname='FFSLHIST') - call addfld('T&IC', (/ 'lev' /), 'I', 'K', 'Temperature', gridname='FFSLHIST') - call add_default('PS&IC',0, 'I') - call add_default('PHIS&IC',0, 'I') - call add_default('T&IC ',0, 'I') - - do m_cnst = 1,pcnst - call addfld(trim(cnst_name(m_cnst))//'&IC', (/ 'lev' /), 'I', 'kg/kg', & - trim(cnst_longname(m_cnst)), gridname='FFSLHIST') - call add_default(trim(cnst_name(m_cnst))//'&IC', 0, 'I') - end do - - ! get aerosol properties - aero_props_obj => aerosol_properties_object() - - if (associated(aero_props_obj)) then - ! determine if there are transported aerosol contistuents - aerosols_transported = aero_props_obj%number_transported()>0 - end if - -end subroutine stepon_init - -!======================================================================= - -subroutine stepon_run1(dtime_out, phys_state, phys_tend, pbuf2d, dyn_in, dyn_out) - - ! ROUTINE: stepon_run1 -- Phase 1 of dynamics run method. - - use physics_buffer, only: physics_buffer_desc - use dp_coupling, only: d_p_coupling - - real(r8), intent(out) :: dtime_out ! Time-step - type (physics_state), intent(inout) :: phys_state(begchunk:endchunk) - type (physics_tend), intent(inout) :: phys_tend(begchunk:endchunk) - type (physics_buffer_desc), pointer :: pbuf2d(:,:) - type (dyn_import_t), intent(inout) :: dyn_in ! Dynamics import container - type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container - - integer :: c - class(aerosol_state), pointer :: aero_state_obj - nullify(aero_state_obj) - - dtime_out = get_step_size() - - call diag_dyn_out(dyn_out,'') - - !---------------------------------------------------------- - ! Move data into phys_state structure. - !---------------------------------------------------------- - - call t_barrierf('sync_d_p_coupling', mpicom) - call t_startf('d_p_coupling') - call d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) - call t_stopf('d_p_coupling') - - !---------------------------------------------------------- - ! update aerosol state object from CAM physics state constituents - !---------------------------------------------------------- - if (aerosols_transported) then - - do c = begchunk,endchunk - aero_state_obj => aerosol_state_object(c) - ! pass number mass or number mixing ratios of aerosol constituents - ! to aerosol state object - call aero_state_obj%set_transported(phys_state(c)%q) - end do - - end if - -end subroutine stepon_run1 - -!======================================================================= - -subroutine stepon_run2(phys_state, phys_tend, dyn_in, dyn_out) - - ! ROUTINE: stepon_run2 -- second phase run method - - use dp_coupling, only: p_d_coupling - use dyn_comp, only: calc_tot_energy_dynamics - - type (physics_state), intent(inout) :: phys_state(begchunk:endchunk) - type (physics_tend), intent(inout) :: phys_tend(begchunk:endchunk) - type (dyn_import_t), intent(inout) :: dyn_in ! Dynamics import container - type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container - - integer :: c - class(aerosol_state), pointer :: aero_state_obj - - ! copy from phys structures -> dynamics structures - - !---------------------------------------------------------- - ! update physics state with aerosol constituents - !---------------------------------------------------------- - nullify(aero_state_obj) - - if (aerosols_transported) then - do c = begchunk,endchunk - aero_state_obj => aerosol_state_object(c) - ! get mass or number mixing ratios of aerosol constituents - call aero_state_obj%get_transported(phys_state(c)%q) - end do - end if - - call t_barrierf('sync_p_d_coupling', mpicom) -#if ( defined CALC_ENERGY ) - call calc_tot_energy_dynamics(dyn_in%atm, 'dED') -#endif - call t_startf('p_d_coupling') - call p_d_coupling(phys_state, phys_tend, dyn_in) - call t_stopf('p_d_coupling') - -#if ( defined CALC_ENERGY ) - call calc_tot_energy_dynamics(dyn_in%atm, 'dBD') -#endif -end subroutine stepon_run2 - -!======================================================================= - -subroutine stepon_run3(dtime, cam_out, phys_state, dyn_in, dyn_out) - - use camsrfexch, only: cam_out_t - use dyn_comp, only: dyn_run - - real(r8), intent(in) :: dtime ! Time-step - type (physics_state), intent(in):: phys_state(begchunk:endchunk) - type (dyn_import_t), intent(inout) :: dyn_in ! Dynamics import container - type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container - type (cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) - - call t_barrierf('sync_dyn_run', mpicom) - call t_startf('dyn_run') - call dyn_run(dyn_out) - call t_stopf('dyn_run') - -end subroutine stepon_run3 - -!======================================================================= - -subroutine stepon_final(dyn_in, dyn_out) - - ! ROUTINE: stepon_final -- Dynamics finalization - - use dyn_comp, only: dyn_final - - type (dyn_import_t), intent(inout) :: dyn_in ! Dynamics import container - type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container - - call t_startf('dyn_final') - call dyn_final(dyn_in, dyn_out) - call t_stopf('dyn_final') - -end subroutine stepon_final - -!======================================================================= - -subroutine diag_dyn_out(dyn_in,suffx) - - use cam_history, only: write_inithist, outfld, hist_fld_active, fieldname_len - use constituents, only: cnst_name, pcnst - use dyn_grid, only: mytile - use fv_arrays_mod, only: fv_atmos_type - use dimensions_mod, only: nlev - - type (dyn_export_t), intent(in) :: dyn_in - character*(*) , intent(in) :: suffx ! suffix for "outfld" names - - - ! local variables - integer :: is,ie,js,je, j, m_cnst,m_cnst_ffsl - integer :: idim - character(len=fieldname_len) :: tfname - - type (fv_atmos_type), pointer :: Atm(:) - - !---------------------------------------------------------------------------- - - Atm=>dyn_in%atm - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - - idim=ie-is+1 - ! Output tracer fields for analysis of advection schemes - do m_cnst = 1, pcnst - m_cnst_ffsl=qsize_tracer_idx_cam2dyn(m_cnst) - tfname = trim(cnst_name(m_cnst))//'_ffsl'//trim(suffx) - if (hist_fld_active(tfname)) then - do j = js, je - call outfld(tfname, RESHAPE(Atm(mytile)%q(is:ie, j, :, m_cnst_ffsl),(/idim,nlev/)), idim, j) - end do - end if - end do - - ! Output tracer fields for analysis of advection schemes - do m_cnst = 1, pcnst - m_cnst_ffsl=qsize_tracer_idx_cam2dyn(m_cnst) - tfname = trim(cnst_name(m_cnst))//'_mass_ffsl'//trim(suffx) - if (hist_fld_active(tfname)) then - do j = js, je - call outfld(tfname,RESHAPE((Atm(mytile)%q(is:ie,j,:,m_cnst_ffsl)*Atm(mytile)%delp(is:ie,j,:)),(/idim,nlev/)),idim, j) - end do - end if - end do - - if (hist_fld_active('U_ffsl'//trim(suffx)) .or. hist_fld_active('V_ffsl'//trim(suffx))) then - do j = js, je - call outfld('U_ffsl'//trim(suffx), RESHAPE(Atm(mytile)%ua(is:ie, j, :),(/idim,nlev/)), idim, j) - call outfld('V_ffsl'//trim(suffx), RESHAPE(Atm(mytile)%va(is:ie, j, :),(/idim,nlev/)), idim, j) - end do - end if - - if (hist_fld_active('U_ffsl_ns'//trim(suffx))) then - do j = js, je+1 - call outfld('U_ffsl_ns'//trim(suffx), RESHAPE(Atm(mytile)%u(is:ie, j, :),(/idim,nlev/)), idim, j) - end do - end if - - if (hist_fld_active('V_ffsl_ew'//trim(suffx))) then - do j = js, je - call outfld('V_ffsl_ew'//trim(suffx), RESHAPE(Atm(mytile)%v(is:ie+1, j, :),(/idim+1,nlev/)), idim+1, j) - end do - end if - - if (hist_fld_active('T_ffsl'//trim(suffx))) then - do j = js, je - call outfld('T_ffsl'//trim(suffx), RESHAPE(Atm(mytile)%pt(is:ie, j, :),(/idim,nlev/)), idim, j) - end do - end if - - if (hist_fld_active('PS_ffsl'//trim(suffx))) then - do j = js, je - call outfld('PS_ffsl'//trim(suffx), Atm(mytile)%ps(is:ie, j), idim, j) - end do - end if - - if (hist_fld_active('PHIS_ffsl'//trim(suffx))) then - do j = js, je - call outfld('PHIS_ffsl'//trim(suffx), Atm(mytile)%phis(is:ie, j), idim, j) - end do - end if - - if (write_inithist()) then - - do j = js, je - call outfld('T&IC', RESHAPE(Atm(mytile)%pt(is:ie, j, :),(/idim,nlev/)), idim, j) - call outfld('U&IC', RESHAPE(Atm(mytile)%ua(is:ie, j, :),(/idim,nlev/)), idim, j) - call outfld('V&IC', RESHAPE(Atm(mytile)%va(is:ie, j, :),(/idim,nlev/)), idim, j) - call outfld('PS&IC', Atm(mytile)%ps(is:ie, j), idim, j) - call outfld('PHIS&IC', Atm(mytile)%phis(is:ie, j), idim, j) - - do m_cnst = 1, pcnst - m_cnst_ffsl=qsize_tracer_idx_cam2dyn(m_cnst) - call outfld(trim(cnst_name(m_cnst))//'&IC', RESHAPE(Atm(mytile)%q(is:ie, j, :, m_cnst_ffsl),(/idim,nlev/)), idim, j) - end do - end do - end if ! if (write_inithist) - -end subroutine diag_dyn_out - -end module stepon diff --git a/src/dynamics/mpas/Makefile b/src/dynamics/mpas/Makefile index 216be0ff1a..2e31cb7ab5 100644 --- a/src/dynamics/mpas/Makefile +++ b/src/dynamics/mpas/Makefile @@ -1,4 +1,8 @@ -CPPFLAGS := -D_MPI -DMPAS_NATIVE_TIMERS -DMPAS_GIT_VERSION=unknown -DMPAS_NAMELIST_SUFFIX=atmosphere -DMPAS_CAM_DYCORE -DMPAS_PIO_SUPPORT -DMPAS_NO_ESMF_INIT +CPPFLAGS := -D_MPI -DMPAS_NATIVE_TIMERS -DMPAS_GIT_VERSION=unknown -DMPAS_NAMELIST_SUFFIX=atmosphere -DMPAS_CAM_DYCORE -DMPAS_NO_ESMF_INIT +$(info $$GPUFLAGS=[${GPUFLAGS}]) +ifdef GPUFLAGS + CPPFLAGS += -DMPAS_OPENACC +endif ifdef PIODEF CPPFLAGS += $(PIODEF) endif @@ -18,7 +22,6 @@ INTERFACE_OBJS = \ mpas_atm_core_interface.o \ mpas_atm_dimensions.o \ mpas_atm_threading.o \ - mpas_atm_halos.o \ cam_mpas_subdriver.o DYN_OBJS = \ @@ -32,11 +35,10 @@ DIAG_OBJS = \ DIAGNOSTICS = \ mpas_atm_diagnostic_template.o \ - mpas_isobaric_diagnostics.o \ - mpas_cloud_diagnostics.o \ - mpas_convective_diagnostics.o \ - mpas_pv_diagnostics.o \ - mpas_soundings.o + isobaric_diagnostics.o \ + convective_diagnostics.o \ + pv_diagnostics.o \ + soundings.o REG_OBJS = \ parse.o \ @@ -92,10 +94,7 @@ FRAME_OBJS = \ mpas_pool_routines.o \ xml_stream_parser.o \ regex_matching.o \ - mpas_log.o \ - mpas_halo.o \ - mpas_string_utils.o - + mpas_log.o UTIL_OBJS = \ ezxml.o @@ -134,8 +133,7 @@ mpas_framework.o: mpas_dmpar.o \ mpas_io_units.o \ mpas_block_decomp.o \ mpas_stream_manager.o \ - mpas_c_interfacing.o \ - mpas_halo.o + mpas_c_interfacing.o mpas_abort.o: mpas_kind_types.o mpas_io_units.o mpas_threading.o @@ -161,7 +159,7 @@ mpas_dmpar.o: mpas_sort.o mpas_kind_types.o mpas_derived_types.o mpas_hash.o mpa mpas_sort.o: mpas_kind_types.o mpas_log.o -mpas_timekeeping.o: mpas_string_utils.o mpas_kind_types.o mpas_derived_types.o mpas_dmpar.o mpas_threading.o mpas_log.o +mpas_timekeeping.o: mpas_kind_types.o mpas_derived_types.o mpas_dmpar.o mpas_threading.o mpas_log.o mpas_timer.o: mpas_kind_types.o mpas_dmpar.o mpas_threading.o mpas_log.o @@ -185,7 +183,6 @@ mpas_stream_manager.o: mpas_io_streams.o mpas_timekeeping.o mpas_derived_types.o mpas_forcing.o: mpas_derived_types.o mpas_timekeeping.o mpas_stream_manager.o mpas_log.o mpas_io_units.o -mpas_halo.o: mpas_derived_types.o mpas_pool_routines.o mpas_log.o # # Operator dependencies @@ -241,10 +238,9 @@ mpas_atm_time_integration.o: mpas_atm_iau.o mpas_atm_dimensions.o mpas_atm_bound # mpas_atm_diagnostics_manager.o: mpas_atm_diagnostics_utils.o $(DIAGNOSTICS) -mpas_cloud_diagnostics.o: mpas_atm_diagnostics_utils.o -mpas_convective_diagnostics.o: mpas_atm_diagnostics_utils.o -mpas_isobaric_diagnostics.o: mpas_atm_diagnostics_utils.o -mpas_pv_diagnostics.o: mpas_atm_diagnostics_utils.o +convective_diagnostics.o: mpas_atm_diagnostics_utils.o +isobaric_diagnostics.o: mpas_atm_diagnostics_utils.o +pv_diagnostics.o: mpas_atm_diagnostics_utils.o # @@ -252,7 +248,7 @@ mpas_pv_diagnostics.o: mpas_atm_diagnostics_utils.o # mpas_atm_core_interface.o: mpas_atm_core.o incs -mpas_atm_core.o: mpas_atm_threading.o mpas_atm_time_integration.o mpas_atm_diagnostics_manager.o mpas_atm_halos.o +mpas_atm_core.o: mpas_atm_threading.o mpas_atm_time_integration.o mpas_atm_diagnostics_manager.o cam_mpas_subdriver.o: mpas_atm_core_interface.o mpas_derived_types.o mpas_framework.o mpas_domain_routines.o mpas_pool_routines.o @@ -268,8 +264,8 @@ clean: $(CC) -c $(CFLAGS) -DUNDERSCORE $(CPPFLAGS) $(CPPINCLUDES) -I$(MPAS_SRC_ROOT)/dycore/src/external/ezxml $< %.o : %.F - $(FC) -c $(CPPFLAGS) $(FFLAGS) $(CPPINCLUDES) $(FCINCLUDES) $< + $(FC) -c $(CPPFLAGS) $(FFLAGS) $(GPUFLAGS) $(CPPINCLUDES) $(FCINCLUDES) $< %.o : %.F90 - $(FC) -c $(CPPFLAGS) $(FFLAGS) $(CPPINCLUDES) $(FCINCLUDES) $< + $(FC) -c $(CPPFLAGS) $(FFLAGS) $(GPUFLAGS) $(CPPINCLUDES) $(FCINCLUDES) $< diff --git a/src/dynamics/mpas/driver/cam_mpas_subdriver.F90 b/src/dynamics/mpas/driver/cam_mpas_subdriver.F90 index 676bacd4af..cc6ac75114 100644 --- a/src/dynamics/mpas/driver/cam_mpas_subdriver.F90 +++ b/src/dynamics/mpas/driver/cam_mpas_subdriver.F90 @@ -278,7 +278,7 @@ subroutine cam_mpas_init_phase4(endrun) use mpas_pool_routines, only : mpas_pool_get_subpool, mpas_pool_get_dimension, mpas_pool_get_config, & mpas_pool_get_field, mpas_pool_get_array, mpas_pool_initialize_time_levels use atm_core, only : atm_mpas_init_block, core_clock => clock - use mpas_atm_halos, only : atm_build_halo_groups, exchange_halo_group + use mpas_dmpar, only : mpas_dmpar_exch_halo_field use atm_time_integration, only : mpas_atm_dynamics_init procedure(halt_model) :: endrun @@ -327,14 +327,6 @@ subroutine cam_mpas_init_phase4(endrun) clock => domain_ptr % clock core_clock => domain_ptr % clock - ! - ! Build halo exchange groups and set method for exchanging halos in a group - ! - call atm_build_halo_groups(domain_ptr, ierr) - if (ierr /= 0) then - call endrun(subname//':failed to build MPAS-A halo exchange groups.') - end if - call mpas_pool_get_config(domain_ptr % blocklist % configs, 'config_do_restart', config_do_restart) call mpas_pool_get_config(domain_ptr % blocklist % configs, 'config_dt', dt) @@ -356,7 +348,9 @@ subroutine cam_mpas_init_phase4(endrun) call mpas_get_time(startTime, dateTimeString=startTimeStamp) - call exchange_halo_group(domain_ptr, 'initialization:u') + call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'state', state) + call mpas_pool_get_field(state, 'u', u_field, 1) + call mpas_dmpar_exch_halo_field(u_field) call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'mesh', mesh) call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'state', state) @@ -373,7 +367,15 @@ subroutine cam_mpas_init_phase4(endrun) call mpas_pool_get_array(state, 'initial_time', initial_time2, 2) initial_time2 = initial_time1 - call exchange_halo_group(domain_ptr, 'initialization:pv_edge,ru,rw') + call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'diag', diag) + call mpas_pool_get_field(diag, 'pv_edge', pv_edge_field) + call mpas_dmpar_exch_halo_field(pv_edge_field) + + call mpas_pool_get_field(diag, 'ru', ru_field) + call mpas_dmpar_exch_halo_field(ru_field) + + call mpas_pool_get_field(diag, 'rw', rw_field) + call mpas_dmpar_exch_halo_field(rw_field) ! ! Prepare the dynamics for integration @@ -907,7 +909,6 @@ subroutine cam_mpas_read_static(fh_ini, endrun) integer :: ierr_total type (MPAS_pool_type), pointer :: meshPool type (MPAS_pool_type), pointer :: reindexPool - type (MPAS_pool_type), pointer :: allPackages, reindexPkgs type (field1DReal), pointer :: latCell, lonCell, xCell, yCell, zCell type (field1DReal), pointer :: latEdge, lonEdge, xEdge, yEdge, zEdge type (field1DReal), pointer :: latVertex, lonVertex, xVertex, yVertex, zVertex @@ -1254,15 +1255,9 @@ subroutine cam_mpas_read_static(fh_ini, endrun) call MPAS_pool_add_config(reindexPool, 'edgesOnVertex', 1) call MPAS_pool_add_config(reindexPool, 'cellsOnVertex', 1) - ! Use an empty package list for reindexPool - call MPAS_pool_create_pool(reindexPkgs) - - call postread_reindex(meshPool, domain_ptr % streamManager % allPackages, & - reindexPool, reindexPkgs) - + call postread_reindex(meshPool, reindexPool) call MPAS_pool_destroy_pool(reindexPool) - call MPAS_pool_destroy_pool(reindexPkgs) end subroutine cam_mpas_read_static @@ -1760,7 +1755,6 @@ subroutine cam_mpas_read_restart(restart_stream, endrun) integer :: ierr type (MPAS_pool_type), pointer :: reindexPool - type (MPAS_pool_type), pointer :: reindexPkgs call MPAS_readStream(restart_stream, 1, ierr=ierr) if (ierr /= MPAS_STREAM_NOERR) then @@ -1888,15 +1882,9 @@ subroutine cam_mpas_read_restart(restart_stream, endrun) call MPAS_pool_add_config(reindexPool, 'edgesOnVertex', 1) call MPAS_pool_add_config(reindexPool, 'cellsOnVertex', 1) - ! Use an empty package list for reindexPool - call MPAS_pool_create_pool(reindexPkgs) - - call postread_reindex(domain_ptr % blocklist % allFields, & - domain_ptr % streamManager % allPackages, & - reindexPool, reindexPkgs) + call postread_reindex(domain_ptr % blocklist % allFields, reindexPool) call MPAS_pool_destroy_pool(reindexPool) - call MPAS_pool_destroy_pool(reindexPkgs) end subroutine cam_mpas_read_restart @@ -1930,7 +1918,6 @@ subroutine cam_mpas_write_restart(restart_stream, endrun) integer :: ierr type (MPAS_pool_type), pointer :: reindexPool - type (MPAS_pool_type), pointer :: reindexPkgs ! ! Re-index from local index space to global index space @@ -1946,11 +1933,7 @@ subroutine cam_mpas_write_restart(restart_stream, endrun) call MPAS_pool_add_config(reindexPool, 'edgesOnVertex', 1) call MPAS_pool_add_config(reindexPool, 'cellsOnVertex', 1) - call MPAS_pool_create_pool(reindexPkgs) - - call prewrite_reindex(domain_ptr % blocklist % allFields, & - domain_ptr % streamManager % allPackages, & - reindexPool, reindexPkgs) + call prewrite_reindex(domain_ptr % blocklist % allFields, reindexPool) call MPAS_writeStream(restart_stream, 1, ierr=ierr) if (ierr /= MPAS_STREAM_NOERR) then @@ -1960,7 +1943,6 @@ subroutine cam_mpas_write_restart(restart_stream, endrun) call postwrite_reindex(domain_ptr % blocklist % allFields, reindexPool) call MPAS_pool_destroy_pool(reindexPool) - call MPAS_pool_destroy_pool(reindexPkgs) call MPAS_closeStream(restart_stream, ierr=ierr) if (ierr /= MPAS_STREAM_NOERR) then @@ -2322,7 +2304,6 @@ subroutine cam_mpas_finalize() use mpas_timer, only : mpas_timer_stop use mpas_framework, only : mpas_framework_finalize use atm_time_integration, only : mpas_atm_dynamics_finalize - use mpas_atm_halos, only : atm_destroy_halo_groups ! Local variables integer :: ierr @@ -2336,12 +2317,6 @@ subroutine cam_mpas_finalize() call mpas_destroy_clock(clock, ierr) call mpas_decomp_destroy_decomp_list(domain_ptr % decompositions) - - call atm_destroy_halo_groups(domain_ptr, ierr) - if (ierr /= 0) then - call endrun(subname//':failed to destroy MPAS-A halo exchange groups.') - end if - call mpas_atm_threading_finalize(domain_ptr % blocklist) call mpas_timer_stop('total time') diff --git a/src/dynamics/mpas/dycore b/src/dynamics/mpas/dycore new file mode 160000 index 0000000000..4319419595 --- /dev/null +++ b/src/dynamics/mpas/dycore @@ -0,0 +1 @@ +Subproject commit 4319419595f7891b57f37275535282d935f41f05 diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index a1b02c1f86..a07d7407f4 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -295,7 +295,6 @@ subroutine dyn_readnl(NLFileName) call mpas_pool_add_config(domain_ptr % configs, 'config_restart_timestamp_name', 'restart_timestamp') call mpas_pool_add_config(domain_ptr % configs, 'config_IAU_option', 'off') call mpas_pool_add_config(domain_ptr % configs, 'config_do_DAcycling', .false.) - call mpas_pool_add_config(domain_ptr % configs, 'config_halo_exch_method', 'mpas_halo') call cam_mpas_init_phase2(pio_subsystem, endrun, timemgr_get_calendar_cf()) @@ -687,7 +686,11 @@ subroutine dyn_final(dyn_in, dyn_out) nullify(dyn_in % theta_m) nullify(dyn_in % rho_zz) nullify(dyn_in % tracers) - deallocate(dyn_in % mpas_from_cam_cnst) + !SS: This a work around for the deallocation bug + !deallocate(dyn_in % mpas_from_cam_cnst) + if (associated(dyn_in % mpas_from_cam_cnst)) then + nullify(dyn_in % mpas_from_cam_cnst) + endif nullify(dyn_in % rho_base) nullify(dyn_in % theta_base) dyn_in % index_qv = 0 @@ -723,7 +726,11 @@ subroutine dyn_final(dyn_in, dyn_out) nullify(dyn_out % theta_m) nullify(dyn_out % rho_zz) nullify(dyn_out % tracers) - deallocate(dyn_out % cam_from_mpas_cnst) + !SS: This a work around for the deallocation bug + !deallocate(dyn_out % cam_from_mpas_cnst) + if (associated(dyn_out % cam_from_mpas_cnst)) then + nullify(dyn_out % cam_from_mpas_cnst) + endif dyn_out % index_qv = 0 nullify(dyn_out % zint) nullify(dyn_out % zz) diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 61b7fc54e9..beba3d3611 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -312,7 +312,7 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) use fvm_mapping, only: phys2dyn_forcings_fvm use test_fvm_mapping, only: test_mapping_overwrite_tendencies use test_fvm_mapping, only: test_mapping_output_mapped_tendencies - + use dimensions_mod, only: use_cslam ! arguments type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state type(physics_tend), intent(inout), dimension(begchunk:endchunk) :: phys_tend @@ -427,8 +427,9 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) !JMD hybrid = config_thread_region(par,'horizontal') hybrid = config_thread_region(par,'serial') call get_loop_ranges(hybrid,ibeg=nets,iend=nete) - - ! high-order mapping of ft and fm (and fq if no cslam) using fvm technology + ! + ! high-order mapping of ft and fm using fvm technology + ! call t_startf('phys2dyn') call phys2dyn_forcings_fvm(elem, dyn_in%fvm, hybrid,nets,nete,ntrac==0, tl_f, tl_qdp) call t_stopf('phys2dyn') @@ -474,19 +475,20 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) dyn_in%elem(ie)%derived%FT(:,:,k) = & dyn_in%elem(ie)%derived%FT(:,:,k) * & dyn_in%elem(ie)%spheremp(:,:) - do m = 1, qsize - dyn_in%elem(ie)%derived%FQ(:,:,k,m) = & - dyn_in%elem(ie)%derived%FQ(:,:,k,m) * & - dyn_in%elem(ie)%spheremp(:,:) - end do end do end if kptr = 0 call edgeVpack(edgebuf, dyn_in%elem(ie)%derived%FM(:,:,:,:), 2*nlev, kptr, ie) kptr = kptr + 2*nlev call edgeVpack(edgebuf, dyn_in%elem(ie)%derived%FT(:,:,:), nlev, kptr, ie) - kptr = kptr + nlev - call edgeVpack(edgebuf, dyn_in%elem(ie)%derived%FQ(:,:,:,:), nlev*qsize, kptr, ie) + if (.not. use_cslam) then + ! + ! if using CSLAM qdp is being overwritten with CSLAM values in the dynamics + ! so no need to do boundary exchange of tracer tendency on GLL grid here + ! + kptr = kptr + nlev + call edgeVpack(edgebuf, dyn_in%elem(ie)%derived%FQ(:,:,:,:), nlev*qsize, kptr, ie) + end if end do if (iam < par%nprocs) then @@ -499,7 +501,9 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) kptr = kptr + 2*nlev call edgeVunpack(edgebuf, dyn_in%elem(ie)%derived%FT(:,:,:), nlev, kptr, ie) kptr = kptr + nlev - call edgeVunpack(edgebuf, dyn_in%elem(ie)%derived%FQ(:,:,:,:), nlev*qsize, kptr, ie) + if (.not. use_cslam) then + call edgeVunpack(edgebuf, dyn_in%elem(ie)%derived%FQ(:,:,:,:), nlev*qsize, kptr, ie) + end if if (fv_nphys > 0) then do k = 1, nlev dyn_in%elem(ie)%derived%FM(:,:,1,k) = & @@ -511,11 +515,6 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) dyn_in%elem(ie)%derived%FT(:,:,k) = & dyn_in%elem(ie)%derived%FT(:,:,k) * & dyn_in%elem(ie)%rspheremp(:,:) - do m = 1, qsize - dyn_in%elem(ie)%derived%FQ(:,:,k,m) = & - dyn_in%elem(ie)%derived%FQ(:,:,k,m) * & - dyn_in%elem(ie)%rspheremp(:,:) - end do end do end if end do @@ -691,23 +690,21 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) end if end do + ! Ensure tracers are all positive + call qneg3('D_P_COUPLING',lchnk ,ncol ,pcols ,pver , & + 1, pcnst, qmin ,phys_state(lchnk)%q) + ! Compute initial geopotential heights - based on full pressure call geopotential_t(phys_state(lchnk)%lnpint, phys_state(lchnk)%lnpmid , phys_state(lchnk)%pint, & phys_state(lchnk)%pmid , phys_state(lchnk)%pdel , phys_state(lchnk)%rpdel , & phys_state(lchnk)%t , phys_state(lchnk)%q(:,:,:), rairv(:,:,lchnk), gravit, zvirv , & phys_state(lchnk)%zi , phys_state(lchnk)%zm , ncol) - ! Compute initial dry static energy, include surface geopotential call update_dry_static_energy_run(pver, gravit, phys_state(lchnk)%t(1:ncol,:), & phys_state(lchnk)%zm(1:ncol,:), & phys_state(lchnk)%phis(1:ncol), & phys_state(lchnk)%s(1:ncol,:), & cpairv(1:ncol,:,lchnk), errflg, errmsg) - - ! Ensure tracers are all positive - call qneg3('D_P_COUPLING',lchnk ,ncol ,pcols ,pver , & - 1, pcnst, qmin ,phys_state(lchnk)%q) - ! Compute energy and water integrals of input state pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) call check_energy_timestep_init(phys_state(lchnk), phys_tend(lchnk), pbuf_chnk) diff --git a/src/dynamics/se/dycore/control_mod.F90 b/src/dynamics/se/dycore/control_mod.F90 index 053f478c6a..6d92e66d7d 100644 --- a/src/dynamics/se/dycore/control_mod.F90 +++ b/src/dynamics/se/dycore/control_mod.F90 @@ -16,6 +16,7 @@ module control_mod integer, public :: rk_stage_user = 0 ! number of RK stages to use integer, public :: ftype = 2 ! Forcing Type integer, public :: ftype_conserve = 1 !conserve momentum (dp*u) + integer, public :: dribble_in_rsplit_loop = 0 integer, public :: statediag_numtrac = 3 integer, public :: qsplit = 1 ! ratio of dynamics tsteps to tracer tsteps diff --git a/src/dynamics/se/dycore/element_mod.F90 b/src/dynamics/se/dycore/element_mod.F90 index 6ba2b36e02..2e758727db 100644 --- a/src/dynamics/se/dycore/element_mod.F90 +++ b/src/dynamics/se/dycore/element_mod.F90 @@ -25,9 +25,8 @@ module element_mod real (kind=r8) :: T (np,np,nlev,timelevels) ! temperature real (kind=r8) :: dp3d (np,np,nlev,timelevels) ! dry delta p on levels real (kind=r8) :: psdry (np,np) ! dry surface pressure - real (kind=r8) :: phis (np,np) ! surface geopotential (prescribed) - real (kind=r8) :: Qdp (np,np,nlev,qsize_d,2) ! Tracer mass - + real (kind=r8) :: phis (np,np) ! surface geopotential (prescribed) + real (kind=r8), allocatable :: Qdp(:,:,:,:,:) ! Tracer mass end type elem_state_t !___________________________________________________________________ @@ -43,20 +42,16 @@ module element_mod real (kind=r8) :: phi(np,np,nlev) ! geopotential real (kind=r8) :: omega(np,np,nlev) ! vertical velocity - ! semi-implicit diagnostics: computed in explict-component, reused in Helmholtz-component. - real (kind=r8) :: zeta(np,np,nlev) ! relative vorticity - real (kind=r8) :: div(np,np,nlev,timelevels) ! divergence - ! tracer advection fields used for consistency and limiters real (kind=r8) :: dp(np,np,nlev) ! for dp_tracers at physics timestep - real (kind=r8) :: divdp(np,np,nlev) ! divergence of dp - real (kind=r8) :: divdp_proj(np,np,nlev) ! DSSed divdp + real (kind=r8), allocatable :: divdp(:,:,:) ! divergence of dp + real (kind=r8), allocatable :: divdp_proj(:,:,:) ! DSSed divdp real (kind=r8) :: mass(MAX(qsize_d,ntrac_d)+9) ! total tracer mass for diagnostics ! forcing terms for CAM - real (kind=r8) :: FQ(np,np,nlev,qsize_d) ! tracer forcing + real (kind=r8), allocatable :: FQ(:,:,:,:) ! tracer forcing real (kind=r8) :: FM(np,np,2,nlev) ! momentum forcing - real (kind=r8) :: FDP(np,np,nlev) ! save full updated dp right after physics + real (kind=r8), allocatable :: FDP(:,:,:) ! save full updated dp right after physics real (kind=r8) :: FT(np,np,nlev) ! temperature forcing real (kind=r8) :: etadot_prescribed(np,np,nlevp) ! prescribed vertical tendency real (kind=r8) :: u_met(np,np,nlev) ! zonal component of prescribed meteorology winds diff --git a/src/dynamics/se/dycore/fvm_control_volume_mod.F90 b/src/dynamics/se/dycore/fvm_control_volume_mod.F90 index c1b3c6fc15..e3208c86cd 100644 --- a/src/dynamics/se/dycore/fvm_control_volume_mod.F90 +++ b/src/dynamics/se/dycore/fvm_control_volume_mod.F90 @@ -128,7 +128,6 @@ module fvm_control_volume_mod ! !****************************************** ! - real (kind=r8) , allocatable :: phis_physgrid(:,:) real (kind=r8) , allocatable :: vtx_cart_physgrid(:,:,:,:) real (kind=r8) , allocatable :: flux_orient_physgrid(:,:,:) integer , allocatable :: ifct_physgrid(:,:) @@ -280,7 +279,6 @@ subroutine allocate_physgrid_vars(fvm,par) end if do ie=1,nelemd - allocate(fvm(ie)%phis_physgrid (fv_nphys,fv_nphys)) allocate(fvm(ie)%vtx_cart_physgrid (4,2,1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys)) allocate(fvm(ie)%flux_orient_physgrid (2,1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys)) allocate(fvm(ie)%ifct_physgrid (1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys)) diff --git a/src/dynamics/se/dycore/fvm_mapping.F90 b/src/dynamics/se/dycore/fvm_mapping.F90 index f52d961be5..0f090ebe9e 100644 --- a/src/dynamics/se/dycore/fvm_mapping.F90 +++ b/src/dynamics/se/dycore/fvm_mapping.F90 @@ -18,13 +18,14 @@ module fvm_mapping use dimensions_mod, only: irecons_tracer use element_mod, only: element_t use fvm_control_volume_mod, only: fvm_struct - use perf_mod, only: t_startf, t_stopf - + use perf_mod, only: t_startf, t_stopf + use cam_abortutils, only: endrun + use cam_logfile, only: iulog implicit none private public :: phys2dyn_forcings_fvm, dyn2phys, dyn2phys_vector, dyn2phys_all_vars,dyn2fvm_mass_vars - public :: phys2dyn,fvm2dyn,dyn2fvm + public :: phys2dyn,fvm2dyn,dyn2fvm,cslam2gll save integer :: save_max_overlap real(kind=r8), allocatable, dimension(:,:,:,:,:) :: save_air_mass_overlap @@ -48,7 +49,6 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ use dimensions_mod, only: np, nc,nlev use dimensions_mod, only: fv_nphys, nhc_phys,ntrac,nhc,ksponge_end, nu_scale_top use hybrid_mod, only: hybrid_t - use cam_abortutils, only: endrun use air_composition, only: thermodynamic_active_species_num, thermodynamic_active_species_idx type (element_t), intent(inout):: elem(:) type(fvm_struct), intent(inout):: fvm(:) @@ -58,8 +58,7 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ integer, intent(in) :: nets, nete, tl_f, tl_qdp integer :: ie,i,j,k,m_cnst,nq - real (kind=r8), dimension(:,:,:,:,:) , allocatable :: fld_phys, fld_gll, fld_fvm - real (kind=r8), allocatable, dimension(:,:,:,:,:) :: qgll + real (kind=r8), dimension(:,:,:,:,:) , allocatable :: fld_phys, fld_gll real (kind=r8) :: element_ave ! ! for tensor product Lagrange interpolation @@ -67,13 +66,7 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ integer :: nflds logical, allocatable :: llimiter(:) - allocate(qgll(np,np,nlev,thermodynamic_active_species_num,nets:nete)) - - do ie=nets,nete - do nq=1,thermodynamic_active_species_num - qgll(:,:,:,nq,ie) = elem(ie)%state%Qdp(:,:,:,nq,tl_qdp)/elem(ie)%state%dp3d(:,:,:,tl_f) - end do - end do + integer :: ierr if (no_cslam) then call endrun("phys2dyn_forcings_fvm: no cslam case: NOT SUPPORTED") @@ -87,9 +80,21 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ ! call t_startf('p2d-pg2:copying') nflds = 4+ntrac - allocate(fld_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,nlev,nflds,nets:nete)) - allocate(fld_gll(np,np,nlev,3,nets:nete)) - allocate(llimiter(nflds)) + allocate(fld_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,nlev,nflds,nets:nete), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'phys2dyn_forcings_fvm: fld_phys allocation error = ',ierr + call endrun('phys2dyn_forcings_fvm: failed to allocate fld_phys array') + end if + allocate(fld_gll(np,np,nlev,3,nets:nete), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'phys2dyn_forcings_fvm: fld_gll allocation error = ',ierr + call endrun('phys2dyn_forcings_fvm: failed to allocate fld_gll array') + end if + allocate(llimiter(3), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'phys2dyn_forcings_fvm: llimiter allocation error = ',ierr + call endrun('phys2dyn_forcings_fvm: failed to allocate llimiter array') + end if fld_phys = -9.99E99_r8!xxx necessary? llimiter = .false. @@ -113,7 +118,8 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ ! ! do mapping of fu,fv,ft ! - call phys2dyn(hybrid,elem,fld_phys(:,:,:,1:3,:),fld_gll(:,:,:,1:3,:),nets,nete,nlev,3,fvm,llimiter(1:3),2,.true.) + call phys2dyn(hybrid,elem,fld_phys(:,:,:,1:3,:),fld_gll,nets,nete,nlev,3,fvm,llimiter, & + istart_vector=2,halo_filled=.true.) do ie=nets,nete elem(ie)%derived%fT(:,:,:) = fld_gll(:,:,:,1,ie) elem(ie)%derived%fM(:,:,1,:) = fld_gll(:,:,:,2,ie) @@ -134,38 +140,7 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ end do end do call t_stopf('p2d-pg2:phys2fvm') - - ! - ! overwrite SE Q with cslam Q - ! - nflds = thermodynamic_active_species_num - allocate(fld_gll(np,np,nlev,nflds,nets:nete)) - allocate(fld_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,nlev,nflds,nets:nete)) - do ie=nets,nete - ! - ! compute cslam updated Q value - do m_cnst=1,thermodynamic_active_species_num - fld_fvm(1:nc,1:nc,:,m_cnst,ie) = fvm(ie)%c(1:nc,1:nc,:,thermodynamic_active_species_idx(m_cnst))+& - fvm(ie)%fc(1:nc,1:nc,:,thermodynamic_active_species_idx(m_cnst))/fvm(ie)%dp_fvm(1:nc,1:nc,:) - enddo - end do - call t_startf('p2d-pg2:fvm2dyn') - llimiter(1:nflds) = .false. - call fvm2dyn(fld_fvm,fld_gll(:,:,:,1:nflds,:),hybrid,nets,nete,nlev,nflds,fvm,llimiter(1:nflds)) - call t_stopf('p2d-pg2:fvm2dyn') - ! - ! fld_gll now holds q cslam value on gll grid - ! - ! convert fld_gll to increment (q_new-q_old) - ! - do ie=nets,nete - do m_cnst=1,thermodynamic_active_species_num - elem(ie)%derived%fq(:,:,:,m_cnst) =& - fld_gll(:,:,:,m_cnst,ie)-qgll(:,:,:,m_cnst,ie) - end do - end do - deallocate(fld_fvm) - !deallocate arrays allocated in dyn2phys_all_vars + !deallocate arrays allocated in dyn2phys_all_vars deallocate(save_air_mass_overlap,save_q_phys,save_q_overlap,& save_overlap_area,save_num_overlap,save_overlap_idx,save_dp_phys) else @@ -178,7 +153,7 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ !***************************************************************************************** ! ! nflds is ft, fu, fv, + thermo species - nflds = 3+thermodynamic_active_species_num + nflds = 3 allocate(fld_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,nlev,nflds,nets:nete)) allocate(fld_gll(np,np,nlev,nflds,nets:nete)) allocate(llimiter(nflds)) @@ -190,18 +165,8 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ fld_phys(1:fv_nphys,1:fv_nphys,:,1,ie) = fvm(ie)%ft(1:fv_nphys,1:fv_nphys,:) fld_phys(1:fv_nphys,1:fv_nphys,:,2,ie) = fvm(ie)%fm(1:fv_nphys,1:fv_nphys,1,:) fld_phys(1:fv_nphys,1:fv_nphys,:,3,ie) = fvm(ie)%fm(1:fv_nphys,1:fv_nphys,2,:) - ! - ! compute cslam mixing ratio with physics update - ! - do m_cnst=1,thermodynamic_active_species_num - do k=1,nlev - fld_phys(1:fv_nphys,1:fv_nphys,k,m_cnst+3,ie) = & - fvm(ie)%c(1:fv_nphys,1:fv_nphys,k,thermodynamic_active_species_idx(m_cnst))+& - fvm(ie)%fc_phys(1:fv_nphys,1:fv_nphys,k,thermodynamic_active_species_idx(m_cnst)) - end do - end do - end do - ! + end do + ! ! do mapping ! call phys2dyn(hybrid,elem,fld_phys,fld_gll,nets,nete,nlev,nflds,fvm,llimiter,2) @@ -210,24 +175,18 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ elem(ie)%derived%fM(:,:,1,:) = fld_gll(:,:,:,2,ie) elem(ie)%derived%fM(:,:,2,:) = fld_gll(:,:,:,3,ie) end do + deallocate(fld_gll) do ie=nets,nete - do m_cnst=1,thermodynamic_active_species_num - ! - ! convert fq so that it will effectively overwrite SE q with CSLAM q - ! - elem(ie)%derived%fq(:,:,:,m_cnst) = fld_gll(:,:,:,m_cnst+3,ie)-& - qgll(:,:,:,m_cnst,ie) - end do do m_cnst = 1,ntrac fvm(ie)%fc(1:nc,1:nc,:,m_cnst) = fvm(ie)%fc_phys(1:nc,1:nc,:,m_cnst)*fvm(ie)%dp_fvm(1:nc,1:nc,:) end do end do end if - deallocate(fld_phys,llimiter,fld_gll,qgll) + deallocate(fld_phys,llimiter) end subroutine phys2dyn_forcings_fvm ! for multiple fields - subroutine fvm2dyntn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimiter) + subroutine fvm2dyntn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimiter,halo_filled) use dimensions_mod, only: np, nhc, nc use hybrid_mod , only: hybrid_t use bndry_mod , only: ghost_exchange @@ -240,7 +199,10 @@ subroutine fvm2dyntn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimit type (hybrid_t) , intent(in) :: hybrid type(fvm_struct) , intent(in) :: fvm(nets:nete) logical , intent(in) :: llimiter(num_flds) + logical, optional , intent(in) :: halo_filled !optional if boundary exchange for fld_fvm has already been called + integer :: ie, iwidth + logical :: fill_halo ! !********************************************* ! @@ -248,13 +210,20 @@ subroutine fvm2dyntn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimit ! !********************************************* ! - do ie=nets,nete - call ghostpack(ghostBufQnhc_s, fld_fvm(:,:,:,:,ie),numlev*num_flds,0,ie) - end do - call ghost_exchange(hybrid,ghostbufQnhc_s,location='fvm2dyntn') - do ie=nets,nete - call ghostunpack(ghostbufQnhc_s, fld_fvm(:,:,:,:,ie),numlev*num_flds,0,ie) - end do + fill_halo = .true. + if (present(halo_filled)) then + fill_halo = .not. halo_filled + end if + + if (fill_halo) then + do ie=nets,nete + call ghostpack(ghostBufQnhc_s, fld_fvm(:,:,:,:,ie),numlev*num_flds,0,ie) + end do + call ghost_exchange(hybrid,ghostbufQnhc_s,location='fvm2dyntn') + do ie=nets,nete + call ghostunpack(ghostbufQnhc_s, fld_fvm(:,:,:,:,ie),numlev*num_flds,0,ie) + end do + end if ! ! mapping ! @@ -267,7 +236,7 @@ subroutine fvm2dyntn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimit end subroutine fvm2dyntn ! for single field - subroutine fvm2dynt1(fld_fvm,fld_gll,hybrid,nets,nete,numlev,fvm,llimiter) + subroutine fvm2dynt1(fld_fvm,fld_gll,hybrid,nets,nete,numlev,fvm,llimiter,halo_filled) use dimensions_mod, only: np, nhc, nc use hybrid_mod , only: hybrid_t use bndry_mod , only: ghost_exchange @@ -280,7 +249,10 @@ subroutine fvm2dynt1(fld_fvm,fld_gll,hybrid,nets,nete,numlev,fvm,llimiter) type (hybrid_t) , intent(in) :: hybrid type(fvm_struct) , intent(in) :: fvm(nets:nete) logical , intent(in) :: llimiter(1) + logical, optional , intent(in) :: halo_filled!optional if boundary exchange for fld_fvm has already been called + integer :: ie, iwidth + logical :: fill_halo ! !********************************************* ! @@ -288,13 +260,20 @@ subroutine fvm2dynt1(fld_fvm,fld_gll,hybrid,nets,nete,numlev,fvm,llimiter) ! !********************************************* ! - do ie=nets,nete - call ghostpack(ghostBufQnhc_t1, fld_fvm(:,:,:,1,ie),numlev,0,ie) - end do - call ghost_exchange(hybrid,ghostbufQnhc_t1,location='fvm2dynt1') - do ie=nets,nete - call ghostunpack(ghostbufQnhc_t1, fld_fvm(:,:,:,1,ie),numlev,0,ie) - end do + fill_halo = .true. + if (present(halo_filled)) then + fill_halo = .not. halo_filled + end if + + if (fill_halo) then + do ie=nets,nete + call ghostpack(ghostBufQnhc_t1, fld_fvm(:,:,:,1,ie),numlev,0,ie) + end do + call ghost_exchange(hybrid,ghostbufQnhc_t1,location='fvm2dynt1') + do ie=nets,nete + call ghostunpack(ghostbufQnhc_t1, fld_fvm(:,:,:,1,ie),numlev,0,ie) + end do + end if ! ! mapping ! @@ -305,7 +284,6 @@ subroutine fvm2dynt1(fld_fvm,fld_gll,hybrid,nets,nete,numlev,fvm,llimiter) end do end subroutine fvm2dynt1 - subroutine fill_halo_phys(fld_phys,hybrid,nets,nete,num_lev,num_flds) use dimensions_mod, only: nhc_phys, fv_nphys use hybrid_mod , only: hybrid_t @@ -354,7 +332,7 @@ subroutine phys2dyn(hybrid,elem,fld_phys,fld_gll,nets,nete,num_lev,num_flds,fvm, type(fvm_struct) , intent(in) :: fvm(:) integer, optional , intent(in) :: istart_vector logical , intent(in) :: llimiter(num_flds) - logical, optional , intent(in) :: halo_filled + logical, optional , intent(in) :: halo_filled!optional if boundary exchange for fld_fvm has already been called integer :: i, j, ie, k, iwidth real (kind=r8) :: v1,v2 @@ -503,7 +481,6 @@ subroutine dyn2phys_all_vars(nets,nete,elem,fvm,& do k=1,nlev inv_darea_dp_fvm = dyn2fvm(elem(ie)%state%dp3d(:,:,k,tl),elem(ie)%metdet(:,:)) inv_darea_dp_fvm = 1.0_r8/inv_darea_dp_fvm - T_phys(:,k,ie) = RESHAPE(dyn2phys(elem(ie)%state%T(:,:,k,tl),elem(ie)%metdet(:,:),inv_area),SHAPE(T_phys(:,k,ie))) Omega_phys(:,k,ie) = RESHAPE(dyn2phys(elem(ie)%derived%omega(:,:,k),elem(ie)%metdet(:,:),inv_area), & SHAPE(Omega_phys(:,k,ie))) @@ -1317,6 +1294,87 @@ subroutine get_q_overlap_save(ie,k,fvm,q_fvm,num_trac,q_phys) save_q_phys(:,:,k,m_cnst,ie) = q_phys(:,:,m_cnst) end do end subroutine get_q_overlap_save + ! + ! Routine to overwrite thermodynamic active tracers on the GLL grid with CSLAM values + ! by Lagrange interpolation from 3x3 CSLAM grid to GLL grid. + ! + subroutine cslam2gll(elem, fvm, hybrid,nets,nete, tl_f, tl_qdp) + use dimensions_mod, only: nc,nlev,np,nhc + use hybrid_mod, only: hybrid_t + use air_composition, only: thermodynamic_active_species_num, thermodynamic_active_species_idx + use fvm_mod, only: ghostBuf_cslam2gll + use bndry_mod, only: ghost_exchange + use edge_mod, only: ghostpack,ghostunpack + + type (element_t), intent(inout):: elem(:) + type(fvm_struct), intent(inout):: fvm(:) + + type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) + integer, intent(in) :: nets, nete, tl_f, tl_qdp + + integer :: ie,i,j,k,m_cnst,nq,ierr + real (kind=r8), dimension(:,:,:,:,:) , allocatable :: fld_fvm, fld_gll + ! + ! for tensor product Lagrange interpolation + ! + integer :: nflds + logical, allocatable :: llimiter(:) + call t_startf('cslam2gll') + nflds = thermodynamic_active_species_num + + !Allocate variables + !------------------ + allocate(fld_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,nlev,nflds,nets:nete), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'cslam2gll: fld_fvm allocation error = ', ierr + call endrun('cslam2gll: failed to allocate fld_fvm array') + end if + + allocate(fld_gll(np,np,nlev,thermodynamic_active_species_num,nets:nete),stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'cslam2gll: fld_gll allocation error = ', ierr + call endrun('cslam2gll: failed to allocate fld_gll array') + end if + allocate(llimiter(nflds), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'cslam2gll: llimiter allocation error = ', ierr + call endrun('cslam2gll: failed to allocate llimiter array') + end if + !------------------ + llimiter(1:nflds) = .false. + do ie=nets,nete + do m_cnst=1,thermodynamic_active_species_num + do k=1,nlev + fld_fvm(1:nc,1:nc,k,m_cnst,ie) = & + fvm(ie)%c(1:nc,1:nc,k,thermodynamic_active_species_idx(m_cnst)) + end do + end do + end do + call t_startf('fvm:fill_halo_cslam2gll') + do ie=nets,nete + call ghostpack(ghostBuf_cslam2gll, fld_fvm(:,:,:,:,ie),nlev*nflds,0,ie) + end do + + call ghost_exchange(hybrid,ghostBuf_cslam2gll,location='cslam2gll') + + do ie=nets,nete + call ghostunpack(ghostBuf_cslam2gll, fld_fvm(:,:,:,:,ie),nlev*nflds,0,ie) + end do + call t_stopf('fvm:fill_halo_cslam2gll') + ! + ! do mapping + ! + call fvm2dyn(fld_fvm,fld_gll,hybrid,nets,nete,nlev,nflds,fvm,llimiter,halo_filled=.true.) + + do ie=nets,nete + do m_cnst=1,thermodynamic_active_species_num + elem(ie)%state%qdp(:,:,:,m_cnst,tl_qdp) = fld_gll(:,:,:,m_cnst,ie)*& + elem(ie)%state%dp3d(:,:,:,tl_f) + end do + end do + deallocate(fld_fvm, fld_gll, llimiter) + call t_stopf('cslam2gll') + end subroutine cslam2gll end module fvm_mapping diff --git a/src/dynamics/se/dycore/fvm_mod.F90 b/src/dynamics/se/dycore/fvm_mod.F90 index 309a101ba2..e2f311ee81 100644 --- a/src/dynamics/se/dycore/fvm_mod.F90 +++ b/src/dynamics/se/dycore/fvm_mod.F90 @@ -36,6 +36,7 @@ module fvm_mod type (EdgeBuffer_t), public :: ghostBufQnhcJet_h type (EdgeBuffer_t), public :: ghostBufFluxJet_h type (EdgeBuffer_t), public :: ghostBufPG_s + type (EdgeBuffer_t), public :: ghostBuf_cslam2gll interface fill_halo_fvm module procedure fill_halo_fvm_noprealloc @@ -496,13 +497,14 @@ subroutine fvm_init2(elem,fvm,hybrid,nets,nete) call initghostbuffer(hybrid%par,ghostBufQ1_vh,elem,klev*(ntrac+1),1,nc,nthreads=vert_num_threads*horz_num_threads) ! call initghostbuffer(hybrid%par,ghostBufFlux_h,elem,4*nlev,nhe,nc,nthreads=horz_num_threads) call initghostbuffer(hybrid%par,ghostBufFlux_vh,elem,4*nlev,nhe,nc,nthreads=vert_num_threads*horz_num_threads) + call initghostbuffer(hybrid%par,ghostBuf_cslam2gll,elem,nlev*thermodynamic_active_species_num,nhc,nc,nthreads=1) ! ! preallocate buffers for physics-dynamics coupling ! if (fv_nphys.ne.nc) then call initghostbuffer(hybrid%par,ghostBufPG_s,elem,nlev*(4+ntrac),nhc_phys,fv_nphys,nthreads=1) else - call initghostbuffer(hybrid%par,ghostBufPG_s,elem,nlev*(3+thermodynamic_active_species_num),nhc_phys,fv_nphys,nthreads=1) + call initghostbuffer(hybrid%par,ghostBufPG_s,elem,nlev*3,nhc_phys,fv_nphys,nthreads=1) end if if (fvm_supercycling.ne.fvm_supercycling_jet) then diff --git a/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 b/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 index b7310ad477..b4708dfd3b 100644 --- a/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 +++ b/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 @@ -105,7 +105,6 @@ subroutine reconstruction(fcube,nlev_in,k_in,recons,irecons,llimiter,ntrac_in,& if(FVM_TIMERS) call t_startf('FVM:reconstruction:part#1') if (nhe>0) then do itr=1,ntrac_in - ! f=-9e9_r8 call extend_panel_interpolate(nc,nhc,nhr,nht,ns,nh,& fcube(:,:,k_in,itr),cubeboundary,halo_interp_weight,ibase,f(:,:,1),f(:,:,2:3)) call get_gradients(f(:,:,:),jx,jy,irecons,recons(:,:,:,itr),& @@ -113,8 +112,6 @@ subroutine reconstruction(fcube,nlev_in,k_in,recons,irecons,llimiter,ntrac_in,& end do else do itr=1,ntrac_in - ! f=-9e9_r8!to avoid floating point exception for uninitialized variables - ! !in non-existent cells (corners of cube) call extend_panel_interpolate(nc,nhc,nhr,nht,ns,nh,& fcube(:,:,k_in,itr),cubeboundary,halo_interp_weight,ibase,f(:,:,1)) call get_gradients(f(:,:,:),jx,jy,irecons,recons(:,:,:,itr),& diff --git a/src/dynamics/se/dycore/global_norms_mod.F90 b/src/dynamics/se/dycore/global_norms_mod.F90 index 17e773d99c..e4701c9d37 100644 --- a/src/dynamics/se/dycore/global_norms_mod.F90 +++ b/src/dynamics/se/dycore/global_norms_mod.F90 @@ -577,7 +577,7 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& deallocate(gp%weights) call automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min_dx,nu_p ,1.0_r8 ,'_p ') - call automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min_dx,nu ,0.5_r8,' ') + call automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min_dx,nu ,1.0_r8,' ') call automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min_dx,nu_div,2.5_r8 ,'_div') if (nu_q<0) nu_q = nu_p ! necessary for consistency @@ -600,29 +600,34 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& lev_set = sponge_del4_lev < 0 if (ptop>1000.0_r8) then ! - ! low top (~1000 Pa) + ! low top; usually idealized test cases ! top_000_032km = .true. + if (hybrid%masterthread) write(iulog,* )"Model top damping configuration: top_000_032km" else if (ptop>100.0_r8) then ! - ! CAM6 top (~225 Pa) + ! CAM6 top (~225 Pa) or CAM7 low top ! top_032_042km = .true. + if (hybrid%masterthread) write(iulog,* )"Model top damping configuration: top_032_042km" else if (ptop>1e-1_r8) then ! ! CAM7 top (~4.35e-1 Pa) ! top_042_090km = .true. + if (hybrid%masterthread) write(iulog,* )"Model top damping configuration: top_042_090km" else if (ptop>1E-4_r8) then ! ! WACCM top (~4.5e-4 Pa) ! top_090_140km = .true. + if (hybrid%masterthread) write(iulog,* )"Model top damping configuration: top_090_140km" else ! ! WACCM-x - geospace (~4e-7 Pa) ! top_140_600km = .true. + if (hybrid%masterthread) write(iulog,* )"Model top damping configuration: top_140_600km" end if ! ! Logging text for sponge layer configuration @@ -634,28 +639,28 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& ! ! if user or namelist is not specifying sponge del4 settings here are best guesses (empirically determined) ! - if (top_000_032km) then + if (top_042_090km) then + if (sponge_del4_lev <0) sponge_del4_lev = 4 + if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 3.375_r8 !max value without having to increase subcycling of div4 + if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 3.375_r8 !max value without having to increase subcycling of div4 + else if (top_090_140km.or.top_140_600km) then ! defaults for waccm(x) + if (sponge_del4_lev <0) sponge_del4_lev = 20 + if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 5.0_r8 + if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 10.0_r8 + else if (sponge_del4_lev <0) sponge_del4_lev = 1 if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 1.0_r8 if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 1.0_r8 end if - if (top_032_042km) then - if (sponge_del4_lev <0) sponge_del4_lev = 3 - if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 1.0_r8 - if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 4.5_r8 - end if - + ! set max wind speed for diagnostics + umax = 120.0_r8 if (top_042_090km) then - if (sponge_del4_lev <0) sponge_del4_lev = 3 - if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 5.0_r8 - if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 7.5_r8 - end if - - if (top_090_140km.or.top_140_600km) then - if (sponge_del4_lev <0) sponge_del4_lev = 10 - if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 5.0_r8 - if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 7.5_r8 + umax = 240._r8 + else if (top_090_140km) then + umax = 300._r8 + else if (top_140_600km) then + umax = 800._r8 end if ! ! Log sponge layer configuration @@ -672,7 +677,6 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& if (lev_set) then write(iulog, '(a,i0)') ' sponge_del4_lev = ',sponge_del4_lev end if - write(iulog,* )"" end if @@ -689,6 +693,7 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& nu_t_lev(k) = (1.0_r8-scale1)*nu_p +scale1*nu_max end if end do + if (hybrid%masterthread)then write(iulog,*) "z computed from barometric formula (using US std atmosphere)" call std_atm_height(pmid(:),z(:)) @@ -696,8 +701,16 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& do k=1,nlev write(iulog,'(i3,5e11.4)') k,pmid(k),z(k),nu_lev(k),nu_t_lev(k),nu_div_lev(k) end do - end if + if (nu_top>0) then + write(iulog,*) ": ksponge_end = ",ksponge_end + write(iulog,*) ": sponge layer Laplacian damping" + write(iulog,*) "k, p, z, nu_scale_top, nu (actual Laplacian damping coefficient)" + do k=1,ksponge_end + write(iulog,'(i3,4e11.4)') k,pmid(k),z(k),nu_scale_top(k),nu_scale_top(k)*nu_top + end do + end if + end if !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! @@ -732,16 +745,6 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& S_laplacian = 2.0_r8 !using forward Euler for sponge diffusion S_hypervis = 2.0_r8 !using forward Euler for hyperviscosity S_rk_tracer = 2.0_r8 - ! - ! estimate max winds - ! - if (ptop>100.0_r8) then - umax = 120.0_r8 - else if (ptop>10.0_r8) then - umax = 400.0_r8 - else - umax = 800.0_r8 - end if ugw = 342.0_r8 !max gravity wave speed @@ -778,13 +781,14 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_dyn_vis (hyperviscosity) ; u,v,T,dM) < ',dt_max_hypervis,& 's ',dt_dyn_visco_actual,'s' if (dt_dyn_visco_actual>dt_max_hypervis) write(iulog,*) 'WARNING: dt_dyn_vis theoretically unstable' - write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_tracer_se (time-stepping tracers ; q ) < ',dt_max_tracer_se,'s ',& + if (.not.use_cslam) then + write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_tracer_se (time-stepping tracers ; q ) < ',dt_max_tracer_se,'s ',& dt_tracer_se_actual,'s' - if (dt_tracer_se_actual>dt_max_tracer_se) write(iulog,*) 'WARNING: dt_tracer_se theoretically unstable' - write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_tracer_vis (hyperviscosity tracers; q ) < ',dt_max_hypervis_tracer,'s',& - dt_tracer_visco_actual,'s' - if (dt_tracer_visco_actual>dt_max_hypervis_tracer) write(iulog,*) 'WARNING: dt_tracer_hypervis theoretically unstable' - + if (dt_tracer_se_actual>dt_max_tracer_se) write(iulog,*) 'WARNING: dt_tracer_se theoretically unstable' + write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_tracer_vis (hyperviscosity tracers; q ) < ',dt_max_hypervis_tracer,'s',& + dt_tracer_visco_actual,'s' + if (dt_tracer_visco_actual>dt_max_hypervis_tracer) write(iulog,*) 'WARNING: dt_tracer_hypervis theoretically unstable' + end if if (use_cslam) then write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_tracer_fvm (time-stepping tracers ; q ) < ',dt_max_tracer_fvm,& 's ',dt_tracer_fvm_actual diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index ed7a627ec4..2732bae233 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -14,7 +14,6 @@ module prim_advance_mod type (EdgeBuffer_t) :: edge3,edgeOmega,edgeSponge real (kind=r8), allocatable :: ur_weights(:) - contains subroutine prim_advance_init(par, elem) @@ -28,7 +27,9 @@ subroutine prim_advance_init(par, elem) integer :: i call initEdgeBuffer(par,edge3 ,elem,4*nlev ,bndry_type=HME_BNDRY_P2P, nthreads=horz_num_threads) - call initEdgeBuffer(par,edgeSponge,elem,4*ksponge_end,bndry_type=HME_BNDRY_P2P, nthreads=horz_num_threads) + if (ksponge_end>0) then + call initEdgeBuffer(par,edgeSponge,elem,4*ksponge_end,bndry_type=HME_BNDRY_P2P, nthreads=horz_num_threads) + end if call initEdgeBuffer(par,edgeOmega ,elem,nlev ,bndry_type=HME_BNDRY_P2P, nthreads=horz_num_threads) if(.not. allocated(ur_weights)) allocate(ur_weights(qsplit)) @@ -112,6 +113,7 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net ! ================================== ! Take timestep ! ================================== + call t_startf('prim_adv_prep') do nq=1,thermodynamic_active_species_num qidx(nq) = nq end do @@ -134,7 +136,7 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net do ie=nets,nete call get_kappa_dry(qwater(:,:,:,:,ie), qidx, kappa(:,:,:,ie)) end do - + call t_stopf('prim_adv_prep') dt_vis = dt @@ -280,7 +282,7 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu real (kind=r8) :: pdel(np,np,nlev) real (kind=r8), allocatable :: ftmp_fvm(:,:,:,:,:) !diagnostics - + call t_startf('applyCAMforc') if (use_cslam) allocate(ftmp_fvm(nc,nc,nlev,ntrac,nets:nete)) if (ftype==0) then @@ -333,7 +335,7 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu ! ! tracers ! - if (qsize>0.and.dt_local_tracer>0) then + if (.not.use_cslam.and.dt_local_tracer>0) then #if (defined COLUMN_OPENMP) !$omp parallel do num_threads(tracer_num_threads) private(q,k,i,j,v1) #endif @@ -389,7 +391,7 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu if (use_cslam) ftmp_fvm(:,:,:,:,ie) = 0.0_r8 end if - if (ftype_conserve==1) then + if (ftype_conserve==1.and..not.use_cslam) then call get_dp(elem(ie)%state%Qdp(:,:,:,1:qsize,np1_qdp), MASS_MIXING_RATIO, & thermodynamic_active_species_idx_dycore, elem(ie)%state%dp3d(:,:,:,np1), pdel) do k=1,nlev @@ -422,6 +424,7 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu end if if (ftype==1.and.nsubstep==1) call tot_energy_dyn(elem,fvm,nets,nete,np1,np1_qdp,'p2d') if (use_cslam) deallocate(ftmp_fvm) + call t_stopf('applyCAMforc') end subroutine applyCAMforcing @@ -441,7 +444,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, use dimensions_mod, only: nu_scale_top,nu_lev,kmvis_ref,kmcnd_ref,rho_ref,km_sponge_factor use dimensions_mod, only: nu_t_lev use control_mod, only: nu, nu_t, hypervis_subcycle,hypervis_subcycle_sponge, nu_p, nu_top - use control_mod, only: molecular_diff + use control_mod, only: molecular_diff,sponge_del4_lev use hybrid_mod, only: hybrid_t!, get_loop_ranges use element_mod, only: element_t use derivative_mod, only: derivative_t, laplace_sphere_wk, vlaplace_sphere_wk, vlaplace_sphere_wk_mol @@ -665,7 +668,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, call tot_energy_dyn(elem,fvm,nets,nete,nt,qn0,'dCH') do ie=nets,nete !$omp parallel do num_threads(vert_num_threads), private(k,i,j,v1,v2,heating) - do k=ksponge_end,nlev + do k=sponge_del4_lev+2,nlev ! ! only do "frictional heating" away from sponge ! diff --git a/src/dynamics/se/dycore/prim_advection_mod.F90 b/src/dynamics/se/dycore/prim_advection_mod.F90 index 17ad85ba61..6ee6d2586c 100644 --- a/src/dynamics/se/dycore/prim_advection_mod.F90 +++ b/src/dynamics/se/dycore/prim_advection_mod.F90 @@ -45,7 +45,7 @@ module prim_advection_mod public :: prim_advec_tracers_fvm public :: vertical_remap - type (EdgeBuffer_t) :: edgeAdv, edgeAdvp1, edgeAdvQminmax, edgeAdv1, edgeveloc + type (EdgeBuffer_t) :: edgeAdv, edgeAdvp1, edgeAdvQminmax, edgeveloc integer,parameter :: DSSeta = 1 integer,parameter :: DSSomega = 2 @@ -63,7 +63,7 @@ module prim_advection_mod subroutine Prim_Advec_Init1(par, elem) - use dimensions_mod, only: nlev, qsize, nelemd,ntrac + use dimensions_mod, only: nlev, qsize, nelemd,ntrac,use_cslam use parallel_mod, only: parallel_t, boundaryCommMethod type(parallel_t) :: par type (element_t) :: elem(:) @@ -80,7 +80,7 @@ subroutine Prim_Advec_Init1(par, elem) ! ! Set the number of threads used in the subroutine Prim_Advec_tracers_remap() ! - if (ntrac>0) then + if (use_cslam) then advec_remap_num_threads = 1 else advec_remap_num_threads = tracer_num_threads @@ -89,17 +89,17 @@ subroutine Prim_Advec_Init1(par, elem) ! allocate largest one first ! Currently this is never freed. If it was, only this first one should ! be freed, as only it knows the true size of the buffer. - call initEdgeBuffer(par,edgeAdvp1,elem,qsize*nlev + nlev,bndry_type=boundaryCommMethod,& - nthreads=horz_num_threads*advec_remap_num_threads) - call initEdgeBuffer(par,edgeAdv,elem,qsize*nlev,bndry_type=boundaryCommMethod, & - nthreads=horz_num_threads*advec_remap_num_threads) - ! This is a different type of buffer pointer allocation - ! used for determine the minimum and maximum value from - ! neighboring elements - call initEdgeSBuffer(par,edgeAdvQminmax,elem,qsize*nlev*2,bndry_type=boundaryCommMethod, & - nthreads=horz_num_threads*advec_remap_num_threads) - - call initEdgeBuffer(par,edgeAdv1,elem,nlev,bndry_type=boundaryCommMethod) + if (.not.use_cslam) then + call initEdgeBuffer(par,edgeAdvp1,elem,qsize*nlev + nlev,bndry_type=boundaryCommMethod,& + nthreads=horz_num_threads*advec_remap_num_threads) + call initEdgeBuffer(par,edgeAdv,elem,qsize*nlev,bndry_type=boundaryCommMethod, & + nthreads=horz_num_threads*advec_remap_num_threads) + ! This is a different type of buffer pointer allocation + ! used for determine the minimum and maximum value from + ! neighboring elements + call initEdgeSBuffer(par,edgeAdvQminmax,elem,qsize*nlev*2,bndry_type=boundaryCommMethod, & + nthreads=horz_num_threads*advec_remap_num_threads) + end if call initEdgeBuffer(par,edgeveloc,elem,2*nlev,bndry_type=boundaryCommMethod) diff --git a/src/dynamics/se/dycore/prim_driver_mod.F90 b/src/dynamics/se/dycore/prim_driver_mod.F90 index 6cfb52e356..dc012e2d12 100644 --- a/src/dynamics/se/dycore/prim_driver_mod.F90 +++ b/src/dynamics/se/dycore/prim_driver_mod.F90 @@ -19,7 +19,6 @@ module prim_driver_mod private public :: prim_init2, prim_run_subcycle, prim_finalize public :: prim_set_dry_mass - contains !=============================================================================! @@ -61,9 +60,10 @@ subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) ! variables used to calculate CFL real (kind=r8) :: dtnu ! timestep*viscosity parameter - real (kind=r8) :: dt_dyn_vis ! viscosity timestep used in dynamics - real (kind=r8) :: dt_dyn_del2_sponge, dt_remap + real (kind=r8) :: dt_dyn_del2_sponge real (kind=r8) :: dt_tracer_vis ! viscosity timestep used in tracers + real (kind=r8) :: dt_dyn_vis ! viscosity timestep + real (kind=r8) :: dt_remap ! remapping timestep real (kind=r8) :: dp,dp0,T1,T0,pmid_ref(np,np) real (kind=r8) :: ps_ref(np,np,nets:nete) @@ -219,7 +219,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst ! use hybvcoord_mod, only : hvcoord_t use se_dyn_time_mod, only: TimeLevel_t, timelevel_update, timelevel_qdp, nsplit - use control_mod, only: statefreq,qsplit, rsplit, variable_nsplit + use control_mod, only: statefreq,qsplit, rsplit, variable_nsplit, dribble_in_rsplit_loop use prim_advance_mod, only: applycamforcing use prim_advance_mod, only: tot_energy_dyn,compute_omega use prim_state_mod, only: prim_printstate, adjust_nsplit @@ -227,8 +227,8 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst use thread_mod, only: omp_get_thread_num use perf_mod , only: t_startf, t_stopf use fvm_mod , only: fill_halo_fvm, ghostBufQnhc_h - use dimensions_mod, only: use_cslam,fv_nphys, ksponge_end - + use dimensions_mod, only: use_cslam,fv_nphys + use fvm_mapping, only: cslam2gll type (element_t) , intent(inout) :: elem(:) type(fvm_struct), intent(inout) :: fvm(:) type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) @@ -245,7 +245,6 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst real (kind=r8) :: dp_np1(np,np) real (kind=r8) :: dp_start(np,np,nlev+1,nets:nete),dp_end(np,np,nlev,nets:nete) logical :: compute_diagnostics - ! =================================== ! Main timestepping loop ! =================================== @@ -282,12 +281,33 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst call TimeLevel_Qdp( tl, qsplit, n0_qdp) - call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF') - call ApplyCAMForcing(elem,fvm,tl%n0,n0_qdp,dt_remap,dt_phys,nets,nete,nsubstep) - call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') + if (dribble_in_rsplit_loop==0) then + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF') + call ApplyCAMForcing(elem,fvm,tl%n0,n0_qdp,dt_remap,dt_phys,nets,nete,nsubstep) + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') + end if do r=1,rsplit if (r.ne.1) call TimeLevel_update(tl,"leapfrog") - call prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r) + ! + ! if nsplit==1 and physics time-step is long then there will be noise in the + ! pressure field; hence "dripple" in tendencies + ! + if (dribble_in_rsplit_loop==1) then + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF') + call ApplyCAMForcing(elem,fvm,tl%n0,n0_qdp,dt,dt_phys,nets,nete,MAX(nsubstep,r)) + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') + end if + ! + ! right after physics overwrite Qdp with CSLAM values + ! + if (use_cslam.and.nsubstep==1.and.r==1) then + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF') + call cslam2gll(elem, fvm, hybrid,nets,nete, tl%n0, n0_qdp) + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') + end if + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBL') + call prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r,nsubstep==nsplit,dt_remap) + call tot_energy_dyn(elem,fvm,nets,nete,tl%np1,n0_qdp,'dAL') enddo @@ -363,7 +383,6 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst end do end do end do - if (nsubstep==nsplit.and.variable_nsplit) then call t_startf('adjust_nsplit') call adjust_nsplit(elem, tl, hybrid,nets,nete, fvm, omega_cn) @@ -389,7 +408,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst end subroutine prim_run_subcycle - subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) + subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep, last_step,dt_remap) ! ! Take qsplit dynamics steps and one tracer step ! for vertically lagrangian option, this subroutine does only the horizontal step @@ -418,7 +437,8 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) use dimensions_mod, only: kmin_jet, kmax_jet use fvm_mod, only: ghostBufQnhc_vh,ghostBufQ1_vh, ghostBufFlux_vh use fvm_mod, only: ghostBufQ1_h,ghostBufQnhcJet_h, ghostBufFluxJet_h - + use se_dyn_time_mod, only: timelevel_qdp + use fvm_mapping, only: cslam2gll #ifdef waccm_debug use cam_history, only: outfld #endif @@ -433,6 +453,8 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) real(kind=r8), intent(in) :: dt ! "timestep dependent" timestep type (TimeLevel_t), intent(inout) :: tl integer, intent(in) :: rstep ! vertical remap subcycling step + logical, intent(in) :: last_step! last step before d_p_coupling + real(kind=r8), intent(in) :: dt_remap type (hybrid_t):: hybridnew,hybridnew2 real(kind=r8) :: st, st1, dp, dt_q @@ -440,6 +462,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) integer :: ithr integer :: region_num_threads integer :: kbeg,kend + integer :: n0_qdp, np1_qdp real (kind=r8) :: tempdp3d(np,np), x real (kind=r8) :: tempmass(nc,nc) @@ -517,7 +540,6 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) end do end if #endif - ! current dynamics state variables: ! derived%dp = dp at start of timestep ! derived%vn0 = mean horiz. flux: U*dp @@ -537,32 +559,19 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) ! special case in CAM: if CSLAM tracers are turned on , qsize=1 but this tracer should ! not be advected. This will be cleaned up when the physgrid is merged into CAM trunk ! Currently advecting all species - if (qsize > 0) then - + if (.not.use_cslam) then call t_startf('prim_advec_tracers_remap') - if(use_cslam) then - ! Deactivate threading in the tracer dimension if this is a CSLAM run - region_num_threads = 1 - else - region_num_threads=tracer_num_threads - endif + region_num_threads=tracer_num_threads call omp_set_nested(.true.) !$OMP PARALLEL NUM_THREADS(region_num_threads), DEFAULT(SHARED), PRIVATE(hybridnew) - if(use_cslam) then - ! Deactivate threading in the tracer dimension if this is a CSLAM run - hybridnew = config_thread_region(hybrid,'serial') - else - hybridnew = config_thread_region(hybrid,'tracer') - endif + hybridnew = config_thread_region(hybrid,'tracer') call Prim_Advec_Tracers_remap(elem, deriv,hvcoord,hybridnew,dt_q,tl,nets,nete) !$OMP END PARALLEL call omp_set_nested(.false.) call t_stopf('prim_advec_tracers_remap') - end if - ! - ! only run fvm transport every fvm_supercycling rstep - ! - if (use_cslam) then + else + ! + ! only run fvm transport every fvm_supercycling rstep ! ! FVM transport ! @@ -594,7 +603,9 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) fvm(ie)%psc(i,j) = sum(fvm(ie)%dp_fvm(i,j,:)) + hvcoord%hyai(1)*hvcoord%ps0 end do end do - end do + end do + call TimeLevel_Qdp( tl, qsplit, n0_qdp, np1_qdp) + if (.not.last_step) call cslam2gll(elem, fvm, hybrid,nets,nete, tl%np1, np1_qdp) else if ((mod(rstep,fvm_supercycling_jet) == 0)) then ! ! shorter fvm time-step in jet region @@ -609,7 +620,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) (/nc*nc,nlev/)), nc*nc, ie) end do #endif - endif + endif end subroutine prim_step diff --git a/src/dynamics/se/dycore/prim_init.F90 b/src/dynamics/se/dycore/prim_init.F90 index 42a336f65c..930b887107 100644 --- a/src/dynamics/se/dycore/prim_init.F90 +++ b/src/dynamics/se/dycore/prim_init.F90 @@ -1,7 +1,7 @@ module prim_init use shr_kind_mod, only: r8=>shr_kind_r8 - use dimensions_mod, only: nc + use dimensions_mod, only: nc, use_cslam use reduction_mod, only: reductionbuffer_ordered_1d_t use quadrature_mod, only: quadrature_t, gausslobatto @@ -22,7 +22,7 @@ subroutine prim_init1(elem, fvm, par, Tl) use cam_logfile, only: iulog use shr_sys_mod, only: shr_sys_flush use thread_mod, only: max_num_threads - use dimensions_mod, only: np, nlev, nelem, nelemd, nelemdmax + use dimensions_mod, only: np, nlev, nelem, nelemd, nelemdmax, qsize_d use dimensions_mod, only: GlobalUniqueCols, fv_nphys,irecons_tracer use control_mod, only: topology, partmethod use element_mod, only: element_t, allocate_element_desc @@ -56,6 +56,7 @@ subroutine prim_init1(elem, fvm, par, Tl) use shr_reprosum_mod, only: repro_sum => shr_reprosum_calc use fvm_analytic_mod, only: compute_basic_coordinate_vars use fvm_control_volume_mod, only: fvm_struct, allocate_physgrid_vars + use air_composition, only: thermodynamic_active_species_num type(element_t), pointer :: elem(:) type(fvm_struct), pointer :: fvm(:) @@ -70,7 +71,7 @@ subroutine prim_init1(elem, fvm, par, Tl) integer :: ie integer :: nets, nete integer :: nelem_edge - integer :: ierr, j + integer :: ierr=0, j logical, parameter :: Debug = .FALSE. real(r8), allocatable :: aratio(:,:) @@ -165,9 +166,49 @@ subroutine prim_init1(elem, fvm, par, Tl) end if call mpi_allreduce(nelemd, nelemdmax, 1, MPI_INTEGER, MPI_MAX, par%comm, ierr) + !Allocate elements: if (nelemd > 0) then - allocate(elem(nelemd)) - call allocate_element_desc(elem) + allocate(elem(nelemd)) + call allocate_element_desc(elem) + !Allocate Qdp and derived FQ arrays: + if(fv_nphys > 0) then !SE-CSLAM + do ie=1,nelemd + allocate(elem(ie)%state%Qdp(np,np,nlev,thermodynamic_active_species_num,1), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate Qdp array') + end if + allocate(elem(ie)%derived%FQ(np,np,nlev,thermodynamic_active_species_num), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate fq array') + end if + end do + else !Regular SE + do ie=1,nelemd + allocate(elem(ie)%state%Qdp(np,np,nlev,qsize_d,2), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate Qdp array') + end if + allocate(elem(ie)%derived%FQ(np,np,nlev,qsize_d), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate fq array') + end if + end do + end if + !Allocate remaining derived quantity arrays: + do ie=1,nelemd + allocate(elem(ie)%derived%FDP(np,np,nlev), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate fdp array') + end if + allocate(elem(ie)%derived%divdp(np,np,nlev), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate divdp array') + end if + allocate(elem(ie)%derived%divdp_proj(np,np,nlev), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate divdp_proj array') + end if + end do end if if (fv_nphys > 0) then @@ -306,7 +347,7 @@ subroutine prim_init1(elem, fvm, par, Tl) elem(ie)%derived%FM=0.0_r8 elem(ie)%derived%FQ=0.0_r8 elem(ie)%derived%FT=0.0_r8 - elem(ie)%derived%FDP=0.0_r8 + elem(ie)%derived%FDP=0.0_r8 elem(ie)%derived%pecnd=0.0_r8 elem(ie)%derived%Omega=0 diff --git a/src/dynamics/se/dycore/se_dyn_time_mod.F90 b/src/dynamics/se/dycore/se_dyn_time_mod.F90 index 4dfd981661..cfe7ad2323 100644 --- a/src/dynamics/se/dycore/se_dyn_time_mod.F90 +++ b/src/dynamics/se/dycore/se_dyn_time_mod.F90 @@ -80,6 +80,7 @@ end subroutine TimeLevel_init_specific !locations for nm1 and n0 for Qdp - because !it only has 2 levels for storage subroutine TimeLevel_Qdp(tl, qsplit, n0, np1) + use dimensions_mod, only: use_cslam type (TimeLevel_t) :: tl integer, intent(in) :: qsplit integer, intent(inout) :: n0 @@ -87,22 +88,26 @@ subroutine TimeLevel_Qdp(tl, qsplit, n0, np1) integer :: i_temp - i_temp = tl%nstep/qsplit - - if (mod(i_temp,2) ==0) then + if (use_cslam) then n0 = 1 - if (present(np1)) then - np1 = 2 - endif + if (present(np1)) np1 = 1 else - n0 = 2 - if (present(np1)) then - np1 = 1 - end if - endif + i_temp = tl%nstep/qsplit + + if (mod(i_temp,2) ==0) then + n0 = 1 + if (present(np1)) then + np1 = 2 + endif + else + n0 = 2 + if (present(np1)) then + np1 = 1 + end if + endif !print * ,'nstep = ', tl%nstep, 'qsplit= ', qsplit, 'i_temp = ', i_temp, 'n0 = ', n0 - + endif end subroutine TimeLevel_Qdp subroutine TimeLevel_update(tl,uptype) diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index d2bfe0fceb..14f1d65167 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -63,7 +63,7 @@ subroutine print_budget(hstwr) ! ! mass budgets dynamics ! - real(r8) :: dMdt_floating_dyn ! mass tendency floating dynamics (dAD-dBD) + real(r8) :: dMdt_floating_dyn ! mass tendency floating dynamics (dAL-dBL) real(r8) :: dMdt_vert_remap ! mass tendency vertical remapping (dAR-dAD) real(r8) :: dMdt_del4_fric_heat ! mass tendency del4 frictional heating (dAH-dCH) real(r8) :: dMdt_del4_tot ! mass tendency del4 + del4 frictional heating (dAH-dBH) @@ -73,7 +73,7 @@ subroutine print_budget(hstwr) ! ! energy budgets dynamics ! - real(r8) :: dEdt_floating_dyn ! dE/dt floating dynamics (dAD-dBD) + real(r8) :: dEdt_floating_dyn ! dE/dt floating dynamics (dAL-dBL) real(r8) :: dEdt_vert_remap ! dE/dt vertical remapping (dAR-dAD) real(r8) :: dEdt_del4 ! dE/dt del4 (dCH-dBH) real(r8) :: dEdt_del4_fric_heat ! dE/dt del4 frictional heating (dAH-dCH) @@ -132,7 +132,7 @@ subroutine print_budget(hstwr) call cam_budget_get_global('dBF' ,idx(i),E_dBF(i)) !state passed to physics end do - call cam_budget_get_global('dAD-dBD',teidx,dEdt_floating_dyn) + call cam_budget_get_global('dAL-dBL',teidx,dEdt_floating_dyn) call cam_budget_get_global('dAR-dAD',teidx,dEdt_vert_remap) dEdt_dycore_dyn = dEdt_floating_dyn+dEdt_vert_remap @@ -459,7 +459,7 @@ subroutine print_budget(hstwr) ! detailed mass budget in dynamical core ! if (is_cam_budget('dAD').and.is_cam_budget('dBD').and.is_cam_budget('dAR').and.is_cam_budget('dCH')) then - call cam_budget_get_global('dAD-dBD',m_cnst,dMdt_floating_dyn) + call cam_budget_get_global('dAL-dBL',m_cnst,dMdt_floating_dyn) call cam_budget_get_global('dAR-dAD',m_cnst,dMdt_vert_remap) tmp = dMdt_floating_dyn+dMdt_vert_remap diff = abs_diff(tmp,0.0_r8,pf=pf) @@ -472,7 +472,7 @@ subroutine print_budget(hstwr) write(iulog,*) "Error: mass non-conservation in dynamical core" write(iulog,*) "(detailed budget below)" write(iulog,*) " " - write(iulog,*)"dMASS/dt 2D dynamics (dAD-dBD) ",dMdt_floating_dyn," Pa/m^2/s" + write(iulog,*)"dMASS/dt 2D dynamics (dAL-dBL) ",dMdt_floating_dyn," Pa/m^2/s" write(iulog,*)"dE/dt vertical remapping (dAR-dAD) ",dMdt_vert_remap write(iulog,*)" " write(iulog,*)"Breakdown of 2D dynamics:" diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 312349eb44..5dcffe7347 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -110,7 +110,7 @@ subroutine dyn_readnl(NLFileName) use control_mod, only: topology, variable_nsplit use control_mod, only: fine_ne, hypervis_power, hypervis_scaling use control_mod, only: max_hypervis_courant, statediag_numtrac,refined_mesh - use control_mod, only: molecular_diff, pgf_formulation + use control_mod, only: molecular_diff, pgf_formulation, dribble_in_rsplit_loop use control_mod, only: sponge_del4_nu_div_fac, sponge_del4_nu_fac, sponge_del4_lev use dimensions_mod, only: ne, npart use dimensions_mod, only: large_Courant_incr @@ -168,7 +168,7 @@ subroutine dyn_readnl(NLFileName) integer :: se_kmax_jet real(r8) :: se_molecular_diff integer :: se_pgf_formulation - + integer :: se_dribble_in_rsplit_loop namelist /dyn_se_inparm/ & se_fine_ne, & ! For refined meshes se_ftype, & ! forcing type @@ -213,8 +213,8 @@ subroutine dyn_readnl(NLFileName) se_kmin_jet, & se_kmax_jet, & se_molecular_diff, & - se_pgf_formulation - + se_pgf_formulation, & + se_dribble_in_rsplit_loop !-------------------------------------------------------------------------- ! defaults for variables not set by build-namelist @@ -288,7 +288,7 @@ subroutine dyn_readnl(NLFileName) call MPI_bcast(se_kmax_jet, 1, mpi_integer, masterprocid, mpicom, ierr) call MPI_bcast(se_molecular_diff, 1, mpi_real8, masterprocid, mpicom, ierr) call MPI_bcast(se_pgf_formulation, 1, mpi_integer, masterprocid, mpicom, ierr) - + call MPI_bcast(se_dribble_in_rsplit_loop, 1, mpi_integer, masterprocid, mpicom, ierr) if (se_npes <= 0) then call endrun('dyn_readnl: ERROR: se_npes must be > 0') end if @@ -356,7 +356,7 @@ subroutine dyn_readnl(NLFileName) variable_nsplit = .false. molecular_diff = se_molecular_diff pgf_formulation = se_pgf_formulation - + dribble_in_rsplit_loop = se_dribble_in_rsplit_loop if (fv_nphys > 0) then ! Use finite volume physics grid and CSLAM for tracer advection nphys_pts = fv_nphys*fv_nphys @@ -472,7 +472,7 @@ subroutine dyn_readnl(NLFileName) end if end if - if (fv_nphys > 0) then + if (use_cslam) then write(iulog, '(a)') 'dyn_readnl: physics will run on FVM points; advection by CSLAM' write(iulog,'(a,i0)') 'dyn_readnl: se_fv_nphys = ', fv_nphys else @@ -618,12 +618,14 @@ subroutine dyn_init(dyn_in, dyn_out) integer :: m_cnst, m ! variables for initializing energy and axial angular momentum diagnostics - integer, parameter :: num_stages = 12 - character (len = 4), dimension(num_stages) :: stage = (/"dED","dAF","dBD","dAD","dAR","dBF","dBH","dCH","dAH","dBS","dAS","p2d"/) + integer, parameter :: num_stages = 14 + character (len = 4), dimension(num_stages) :: stage = (/"dED","dAF","dBD","dBL","dAL","dAD","dAR","dBF","dBH","dCH","dAH","dBS","dAS","p2d"/) character (len = 70),dimension(num_stages) :: stage_txt = (/& " end of previous dynamics ",& !dED " from previous remapping or state passed to dynamics",& !dAF - state in beginning of nsplit loop " state after applying CAM forcing ",& !dBD - state after applyCAMforcing + " before floating dynamics ",& !dBL + " after floating dynamics ",& !dAL " before vertical remapping ",& !dAD - state before vertical remapping " after vertical remapping ",& !dAR - state at end of nsplit loop " state passed to parameterizations ",& !dBF @@ -799,28 +801,49 @@ subroutine dyn_init(dyn_in, dyn_out) ! nu_scale_top(:) = 0.0_r8 if (nu_top>0) then - ptop = hvcoord%hyai(1)*hvcoord%ps0 - if (ptop>300.0_r8) then - ! - ! for low tops the tanh formulae below makes the sponge excessively deep - ! - nu_scale_top(1) = 4.0_r8 - nu_scale_top(2) = 2.0_r8 - nu_scale_top(3) = 1.0_r8 - ksponge_end = 3 - else - do k=1,nlev - press = hvcoord%hyam(k)*hvcoord%ps0+hvcoord%hybm(k)*pstd - nu_scale_top(k) = 8.0_r8*(1.0_r8+tanh(1.0_r8*log(ptop/press(1)))) ! tau will be maximum 8 at model top - if (nu_scale_top(k).ge.0.15_r8) then - ksponge_end = k - else - nu_scale_top(k) = 0.0_r8 - end if - end do - end if + ptop = hvcoord%hyai(1)*hvcoord%ps0 + if (ptop>300.0_r8) then + ! + ! for low tops the tanh formulae below makes the sponge excessively deep + ! + nu_scale_top(1) = 4.0_r8 + nu_scale_top(2) = 2.0_r8 + nu_scale_top(3) = 1.0_r8 + ksponge_end = 3 + else if (ptop>100.0_r8) then + ! + ! CAM6 top (~225 Pa) or CAM7 low top + ! + ! For backwards compatibility numbers below match tanh profile + ! used in FV + ! + nu_scale_top(1) = 4.4_r8 + nu_scale_top(2) = 1.3_r8 + nu_scale_top(3) = 3.9_r8 + ksponge_end = 3 + else if (ptop>1e-1_r8) then + ! + ! CAM7 FMT + ! + nu_scale_top(1) = 3.0_r8 + nu_scale_top(2) = 1.0_r8 + nu_scale_top(3) = 0.1_r8 + nu_scale_top(4) = 0.05_r8 + ksponge_end = 4 + else if (ptop>1e-4_r8) then + ! + ! WACCM and WACCM-x + ! + nu_scale_top(1) = 5.0_r8 + nu_scale_top(2) = 5.0_r8 + nu_scale_top(3) = 5.0_r8 + nu_scale_top(4) = 2.0_r8 + nu_scale_top(5) = 1.0_r8 + nu_scale_top(6) = 0.1_r8 + ksponge_end = 6 + end if else - ksponge_end = 0 + ksponge_end = 0 end if ksponge_end = MAX(MAX(ksponge_end,1),kmol_end) if (masterproc) then @@ -906,8 +929,8 @@ subroutine dyn_init(dyn_in, dyn_out) ! ! Register tendency (difference) budgets ! - call cam_budget_em_register('dEdt_floating_dyn' ,'dAD','dBD','dyn','dif', & - longname="dE/dt floating dynamics (dAD-dBD)" ) + call cam_budget_em_register('dEdt_floating_dyn' ,'dAL','dBL','dyn','dif', & + longname="dE/dt floating dynamics (dAL-dBL)" ) call cam_budget_em_register('dEdt_vert_remap' ,'dAR','dAD','dyn','dif', & longname="dE/dt vertical remapping (dAR-dAD)" ) call cam_budget_em_register('dEdt_phys_tot_in_dyn','dBD','dAF','dyn','dif', & @@ -963,11 +986,10 @@ subroutine dyn_run(dyn_state) use air_composition, only: thermodynamic_active_species_idx_dycore use prim_driver_mod, only: prim_run_subcycle use dimensions_mod, only: cnst_name_gll - use se_dyn_time_mod, only: tstep, nsplit, timelevel_qdp + use se_dyn_time_mod, only: tstep, nsplit, timelevel_qdp, tevolve use hybrid_mod, only: config_thread_region, get_loop_ranges use control_mod, only: qsplit, rsplit, ftype_conserve use thread_mod, only: horz_num_threads - use se_dyn_time_mod, only: tevolve type(dyn_export_t), intent(inout) :: dyn_state @@ -1042,24 +1064,23 @@ subroutine dyn_run(dyn_state) end if end do - - ! convert elem(ie)%derived%fq to mass tendency - do ie = nets, nete - do m = 1, qsize + if (.not.use_cslam) then + do ie = nets, nete + do m = 1, qsize do k = 1, nlev - do j = 1, np - do i = 1, np - dyn_state%elem(ie)%derived%FQ(i,j,k,m) = dyn_state%elem(ie)%derived%FQ(i,j,k,m)* & - rec2dt*dyn_state%elem(ie)%state%dp3d(i,j,k,tl_f) - end do - end do + do j = 1, np + do i = 1, np + dyn_state%elem(ie)%derived%FQ(i,j,k,m) = dyn_state%elem(ie)%derived%FQ(i,j,k,m)* & + rec2dt*dyn_state%elem(ie)%state%dp3d(i,j,k,tl_f) + end do + end do end do - end do - end do - + end do + end do + end if - if (ftype_conserve>0) then + if (ftype_conserve>0.and..not.use_cslam) then do ie = nets, nete do k=1,nlev do j=1,np @@ -1076,7 +1097,6 @@ subroutine dyn_run(dyn_state) end do end if - if (use_cslam) then do ie = nets, nete do m = 1, ntrac @@ -1795,6 +1815,7 @@ subroutine set_phis(dyn_in) integer :: ierr, pio_errtype character(len=max_fieldname_len) :: fieldname + character(len=max_fieldname_len) :: fieldname_gll character(len=max_hcoordname_len):: grid_name integer :: dims(2) integer :: dyn_cols @@ -1828,7 +1849,7 @@ subroutine set_phis(dyn_in) allocate(phis_tmp(npsq,nelemd)) phis_tmp = 0.0_r8 - if (fv_nphys > 0) then + if (use_cslam) then allocate(phis_phys_tmp(fv_nphys**2,nelemd)) phis_phys_tmp = 0.0_r8 do ie=1,nelemd @@ -1853,7 +1874,7 @@ subroutine set_phis(dyn_in) ! Set name of grid object which will be used to read data from file ! into internal data structure via PIO. - if (fv_nphys == 0) then + if (.not.use_cslam) then grid_name = 'GLL' else grid_name = 'physgrid_d' @@ -1878,13 +1899,38 @@ subroutine set_phis(dyn_in) end if fieldname = 'PHIS' - if (dyn_field_exists(fh_topo, trim(fieldname))) then - if (fv_nphys == 0) then - call read_dyn_var(fieldname, fh_topo, 'ncol', phis_tmp) + fieldname_gll = 'PHIS_gll' + if (use_cslam.and.dyn_field_exists(fh_topo, trim(fieldname_gll),required=.false.)) then + ! + ! If physgrid it is recommended to read in PHIS on the GLL grid and then + ! map to the physgrid in d_p_coupling + ! + ! This requires a topo file with PHIS_gll on it ... + ! + if (masterproc) then + write(iulog, *) "Reading in PHIS on GLL grid (mapped to physgrid in d_p_coupling)" + end if + call read_dyn_var(fieldname_gll, fh_topo, 'ncol_gll', phis_tmp) + else if (dyn_field_exists(fh_topo, trim(fieldname))) then + if (.not.use_cslam) then + if (masterproc) then + write(iulog, *) "Reading in PHIS" + end if + call read_dyn_var(fieldname, fh_topo, 'ncol', phis_tmp) else - call read_phys_field_2d(fieldname, fh_topo, 'ncol', phis_phys_tmp) - call map_phis_from_physgrid_to_gll(dyn_in%fvm, elem, phis_phys_tmp, & - phis_tmp, pmask) + ! + ! For backwards compatibility we allow reading in PHIS on the physgrid + ! which is then mapped to the GLL grid and back to the physgrid in d_p_coupling + ! (the latter is to avoid noise in derived quantities such as PSL) + ! + if (masterproc) then + write(iulog, *) "Reading in PHIS on physgrid" + write(iulog, *) "Recommended to read in PHIS on GLL grid" + end if + call read_phys_field_2d(fieldname, fh_topo, 'ncol', phis_phys_tmp) + call map_phis_from_physgrid_to_gll(dyn_in%fvm, elem, phis_phys_tmp, & + phis_tmp, pmask) + deallocate(phis_phys_tmp) end if else call endrun(sub//': Could not find PHIS field on input datafile') @@ -1916,44 +1962,6 @@ subroutine set_phis(dyn_in) PHIS_OUT=phis_tmp, mask=pmask(:)) deallocate(glob_ind) - if (fv_nphys > 0) then - - ! initialize PHIS on physgrid - allocate(latvals_phys(fv_nphys*fv_nphys*nelemd)) - allocate(lonvals_phys(fv_nphys*fv_nphys*nelemd)) - indx = 1 - do ie = 1, nelemd - do j = 1, fv_nphys - do i = 1, fv_nphys - latvals_phys(indx) = dyn_in%fvm(ie)%center_cart_physgrid(i,j)%lat - lonvals_phys(indx) = dyn_in%fvm(ie)%center_cart_physgrid(i,j)%lon - indx = indx + 1 - end do - end do - end do - - allocate(pmask_phys(fv_nphys*fv_nphys*nelemd)) - pmask_phys(:) = .true. - allocate(glob_ind(fv_nphys*fv_nphys*nelemd)) - - j = 1 - do ie = 1, nelemd - do i = 1, fv_nphys*fv_nphys - ! Create a global(ish) column index - glob_ind(j) = elem(ie)%GlobalId - j = j + 1 - end do - end do - - call analytic_ic_set_ic(vcoord, latvals_phys, lonvals_phys, glob_ind, & - PHIS_OUT=phis_phys_tmp, mask=pmask_phys) - - deallocate(latvals_phys) - deallocate(lonvals_phys) - deallocate(pmask_phys) - deallocate(glob_ind) - end if - end if deallocate(pmask) @@ -1969,16 +1977,7 @@ subroutine set_phis(dyn_in) end do end do end do - if (fv_nphys > 0) then - do ie = 1, nelemd - dyn_in%fvm(ie)%phis_physgrid = RESHAPE(phis_phys_tmp(:,ie),(/fv_nphys,fv_nphys/)) - end do - end if - deallocate(phis_tmp) - if (fv_nphys > 0) then - deallocate(phis_phys_tmp) - end if ! boundary exchange to update the redundent columns in the element objects do ie = 1, nelemd diff --git a/src/dynamics/se/dyn_grid.F90 b/src/dynamics/se/dyn_grid.F90 index 293f7402dd..aa3ec8027a 100644 --- a/src/dynamics/se/dyn_grid.F90 +++ b/src/dynamics/se/dyn_grid.F90 @@ -177,12 +177,12 @@ subroutine dyn_grid_init() if (iam < par%nprocs) then call prim_init1(elem, fvm, par, TimeLevel) - if (fv_nphys > 0) then + if (use_cslam) then call dp_init(elem, fvm) end if if (fv_nphys > 0) then - qsize_local = thermodynamic_active_species_num + 3 + qsize_local = 3 else qsize_local = pcnst + 3 end if diff --git a/src/dynamics/se/gravity_waves_sources.F90 b/src/dynamics/se/gravity_waves_sources.F90 index 9adffc001b..a19733b465 100644 --- a/src/dynamics/se/gravity_waves_sources.F90 +++ b/src/dynamics/se/gravity_waves_sources.F90 @@ -141,7 +141,7 @@ subroutine compute_frontogenesis(frontgf,frontga,tl,tlq,elem,ederiv,hybrid,nets, do ie=nets,nete ! pressure at model top - pint(:,:) = hvcoord%hyai(1) + pint(:,:) = hvcoord%hyai(1)*hvcoord%ps0 do k=1,nlev ! moist pressure at mid points sum_water(:,:) = 1.0_r8 diff --git a/src/hemco b/src/hemco new file mode 160000 index 0000000000..3a6d999ab0 --- /dev/null +++ b/src/hemco @@ -0,0 +1 @@ +Subproject commit 3a6d999ab0dbee9f03ab6b9a13dd3b6d9670eb54 diff --git a/src/ionosphere/waccmx/edyn_grid_comp.F90 b/src/ionosphere/waccmx/edyn_grid_comp.F90 deleted file mode 100644 index 3796879fb1..0000000000 --- a/src/ionosphere/waccmx/edyn_grid_comp.F90 +++ /dev/null @@ -1,481 +0,0 @@ -!------------------------------------------------------------------------------- -! This localizes ESMF regridding operations to allow for multiple instances of -! CAM. -!------------------------------------------------------------------------------- -module edyn_grid_comp - use shr_kind_mod, only: r8 => shr_kind_r8, cs=>shr_kind_cs, cl=>shr_kind_cl - use ESMF, only: ESMF_KIND_I4, ESMF_Mesh, ESMF_DistGrid - use ESMF, only: ESMF_State, ESMF_Clock, ESMF_GridComp - use ppgrid, only: pcols - use cam_logfile, only: iulog - use shr_sys_mod, only: shr_sys_flush - use cam_abortutils, only: endrun - - implicit none - - private - - public :: edyn_grid_comp_init - public :: edyn_grid_comp_run1 - public :: edyn_grid_comp_run2 - public :: edyn_grid_comp_final - - ! Private data and interfaces - ! phys_mesh: Local copy of physics grid - type(ESMF_Mesh) :: phys_mesh - ! edyn_comp: ESMF gridded component for the ionosphere models - type(ESMF_GridComp) :: phys_comp - ! Local copy of ionosphere epotential model - character(len=16) :: ionos_epotential_model = 'none' - ! Total number of columns on this task - integer :: total_cols = 0 - integer :: col_start = 1 - integer :: col_end = -1 - integer :: nlev = 0 - ! dist_grid_2d: DistGrid for 2D fields - type(ESMF_DistGrid) :: dist_grid_2d - ! Which run? - integer :: do_run - ! Pointers for run1 output - real(r8), pointer :: prescr_efx_phys(:) => NULL() - real(r8), pointer :: prescr_kev_phys(:) => NULL() - logical :: ionos_epotential_amie - logical :: ionos_epotential_ltr - ! Pointers for run2 - real(r8), pointer :: omega_blck(:,:) => NULL() - real(r8), pointer :: pmid_blck(:,:) => NULL() - real(r8), pointer :: zi_blck(:,:) => NULL() - real(r8), pointer :: hi_blck(:,:) => NULL() - real(r8), pointer :: u_blck(:,:) => NULL() - real(r8), pointer :: v_blck(:,:) => NULL() - real(r8), pointer :: tn_blck(:,:) => NULL() - real(r8), pointer :: sigma_ped_blck(:,:) => NULL() - real(r8), pointer :: sigma_hall_blck(:,:) => NULL() - real(r8), pointer :: te_blck(:,:) => NULL() - real(r8), pointer :: ti_blck(:,:) => NULL() - real(r8), pointer :: mbar_blck(:,:) => NULL() - real(r8), pointer :: n2mmr_blck(:,:) => NULL() - real(r8), pointer :: o2mmr_blck(:,:) => NULL() - real(r8), pointer :: o1mmr_blck(:,:) => NULL() - real(r8), pointer :: o2pmmr_blck(:,:) => NULL() - real(r8), pointer :: nopmmr_blck(:,:) => NULL() - real(r8), pointer :: n2pmmr_blck(:,:) => NULL() - real(r8), pointer :: opmmr_blck(:,:) => NULL() - real(r8), pointer :: opmmrtm1_blck(:,:) => NULL() - real(r8), pointer :: ui_blck(:,:) => NULL() - real(r8), pointer :: vi_blck(:,:) => NULL() - real(r8), pointer :: wi_blck(:,:) => NULL() - real(r8) :: rmassO2p - real(r8) :: rmassNOp - real(r8) :: rmassN2p - real(r8) :: rmassOp - -CONTAINS - - subroutine edyn_gcomp_init(comp, importState, exportState, clock, rc) - use ESMF, only: ESMF_DistGridCreate, ESMF_MeshCreate - use ESMF, only: ESMF_FILEFORMAT_ESMFMESH, ESMF_MeshGet - use cam_instance, only: inst_name - use phys_control, only: phys_getopts - use phys_grid, only: get_ncols_p, get_gcol_p, get_rlon_all_p, get_rlat_all_p - use ppgrid, only: begchunk, endchunk - use edyn_esmf, only: edyn_esmf_chkerr, edyn_esmf_update_phys_mesh - use shr_const_mod,only: shr_const_pi - - ! Dummy arguments - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! Local variables - integer :: ncols - integer :: chnk, col, dindex - integer, allocatable :: decomp(:) - character(len=cl) :: grid_file - character(len=*), parameter :: subname = 'edyn_gcomp_init' - real(r8) , parameter :: radtodeg = 180.0_r8/shr_const_pi - integer :: spatialDim - integer :: numOwnedElements - real(r8), pointer :: ownedElemCoords(:) - real(r8), pointer :: lat(:), latMesh(:) - real(r8), pointer :: lon(:), lonMesh(:) - real(r8) :: lats(pcols) ! array of chunk latitudes - real(r8) :: lons(pcols) ! array of chunk longitude - integer :: i, c, n - character(len=cs) :: tempc1,tempc2 - character(len=300) :: errstr - - real(r8), parameter :: abstol = 1.e-6_r8 - - ! Find the physics grid file - call phys_getopts(physics_grid_out=grid_file) - ! Compute the local decomp - total_cols = 0 - do chnk = begchunk, endchunk - total_cols = total_cols + get_ncols_p(chnk) - end do - allocate(decomp(total_cols)) - dindex = 0 - do chnk = begchunk, endchunk - ncols = get_ncols_p(chnk) - do col = 1, ncols - dindex = dindex + 1 - decomp(dindex) = get_gcol_p(chnk, col) - end do - end do - ! Create a DistGrid based on the physics decomp - dist_grid_2d = ESMF_DistGridCreate(arbSeqIndexList=decomp, rc=rc) - call edyn_esmf_chkerr(subname, 'ESMF_DistGridCreate phys decomp', rc) - ! Create an ESMF_mesh for the physics decomposition - phys_mesh = ESMF_MeshCreate(trim(grid_file), ESMF_FILEFORMAT_ESMFMESH, & - elementDistgrid=dist_grid_2d, rc=rc) - call edyn_esmf_chkerr(subname, 'ESMF_MeshCreateFromFile', rc) - call edyn_esmf_update_phys_mesh(phys_mesh) - do_run = 1 - - - ! Check that the mesh coordinates are consistent with the model physics column coordinates - - ! obtain mesh lats and lons - call ESMF_MeshGet(phys_mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - call edyn_esmf_chkerr(subname, 'ESMF_MeshGet', rc) - - if (numOwnedElements /= total_cols) then - write(tempc1,'(i10)') numOwnedElements - write(tempc2,'(i10)') total_cols - call endrun(trim(subname)//": ERROR numOwnedElements "// & - trim(tempc1) //" not equal to local size "// trim(tempc2)) - end if - - allocate(ownedElemCoords(spatialDim*numOwnedElements)) - allocate(lonMesh(total_cols), latMesh(total_cols)) - call ESMF_MeshGet(phys_mesh, ownedElemCoords=ownedElemCoords) - - do n = 1,total_cols - lonMesh(n) = ownedElemCoords(2*n-1) - latMesh(n) = ownedElemCoords(2*n) - end do - - ! obtain internally generated cam lats and lons - allocate(lon(total_cols)); lon(:) = 0._r8 - allocate(lat(total_cols)); lat(:) = 0._r8 - n=0 - do c = begchunk, endchunk - ncols = get_ncols_p(c) - ! latitudes and longitudes returned in radians - call get_rlat_all_p(c, ncols, lats) - call get_rlon_all_p(c, ncols, lons) - do i=1,ncols - n = n+1 - lat(n) = lats(i)*radtodeg - lon(n) = lons(i)*radtodeg - end do - end do - - errstr = '' - ! error check differences between internally generated lons and those read in - do n = 1,total_cols - if (abs(lonMesh(n) - lon(n)) > abstol) then - if ( (abs(lonMesh(n)-lon(n)) > 360._r8+abstol) .or. (abs(lonMesh(n)-lon(n)) < 360._r8-abstol) ) then - write(errstr,100) n,lon(n),lonMesh(n), abs(lonMesh(n)-lon(n)) - write(iulog,*) trim(errstr) - endif - end if - if (abs(latMesh(n) - lat(n)) > abstol) then - ! poles in the 4x5 SCRIP file seem to be off by 1 degree - if (.not.( (abs(lat(n))>88.0_r8) .and. (abs(latMesh(n))>88.0_r8) )) then - write(errstr,101) n,lat(n),latMesh(n), abs(latMesh(n)-lat(n)) - write(iulog,*) trim(errstr) - endif - end if - end do - - if ( len_trim(errstr) > 0 ) then - call endrun(subname//': physics mesh coords do not match model coords') - end if - - ! deallocate memory - deallocate(ownedElemCoords) - deallocate(lon, lonMesh) - deallocate(lat, latMesh) - deallocate(decomp) - -100 format('edyn_gcomp_init: coord mismatch... n, lon(n), lonmesh(n), diff_lon = ',i6,2(f21.13,3x),d21.5) -101 format('edyn_gcomp_init: coord mismatch... n, lat(n), latmesh(n), diff_lat = ',i6,2(f21.13,3x),d21.5) - - end subroutine edyn_gcomp_init - - !----------------------------------------------------------------------- - subroutine edyn_gcomp_run(comp, importState, exportState, clock, rc) - use ESMF, only: ESMF_SUCCESS, ESMF_Array, ESMF_ArrayGet - use ESMF, only: ESMF_StateGet - use epotential_params, only: epot_crit_colats - use edyn_esmf, only: edyn_esmf_chkerr - use dpie_coupling, only: d_pie_epotent - use dpie_coupling, only: d_pie_coupling - - ! Dummy arguments - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - ! Local variables - type(ESMF_Array) :: run_type - integer :: cols, cole, blksize - character(len=cs) :: errmsg - character(len=*), parameter :: subname = 'edyn_gcomp_run' - - if (do_run == 1) then - if ( ionos_epotential_amie .or. ionos_epotential_ltr) then - call d_pie_epotent(ionos_epotential_model, epot_crit_colats, & - cols=col_start, cole=col_end, & - efx_phys=prescr_efx_phys, kev_phys=prescr_kev_phys, & - amie_in=ionos_epotential_amie, ltr_in=ionos_epotential_ltr ) - else - call d_pie_epotent(ionos_epotential_model, epot_crit_colats) - end if - else if (do_run == 2) then - call d_pie_coupling(omega_blck, pmid_blck, zi_blck, hi_blck, & - u_blck, v_blck, tn_blck, sigma_ped_blck, sigma_hall_blck, & - te_blck, ti_blck, mbar_blck, n2mmr_blck, o2mmr_blck, & - o1mmr_blck, o2pmmr_blck, nopmmr_blck, n2pmmr_blck, & - opmmr_blck, opmmrtm1_blck, ui_blck, vi_blck, wi_blck, & - rmassO2p, rmassNOp, rmassN2p, rmassOp, col_start, col_end, nlev) - else - write(errmsg, '(2a,i0)') subname, ': Unknown run number, ', do_run - call endrun(trim(errmsg)) - end if - - rc = ESMF_SUCCESS - - end subroutine edyn_gcomp_run - !----------------------------------------------------------------------- - subroutine edyn_gcomp_final(comp, importState, exportState, clock, rc) - use ESMF, only: ESMF_MeshDestroy - use ESMF, only: ESMF_SUCCESS - use edyn_esmf, only: edyn_esmf_chkerr - - ! Dummy arguments - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - ! Local variables - character(len=*), parameter :: subname = 'edyn_gcomp_final' - - call ESMF_MeshDestroy(phys_mesh, rc=rc) - rc = ESMF_SUCCESS - - end subroutine edyn_gcomp_final - - !----------------------------------------------------------------------- - subroutine edyn_gcomp_SetServices(comp, rc) - use ESMF, only: ESMF_GridCompSetEntryPoint - use ESMF, only: ESMF_METHOD_INITIALIZE, ESMF_METHOD_RUN - use ESMF, only: ESMF_METHOD_FINALIZE, ESMF_SUCCESS - use edyn_esmf, only: edyn_esmf_chkerr - - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - character(len=*), parameter :: subname = 'edyn_gcomp_SetServices' - - ! Set the entry points for standard ESMF Component methods - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - userRoutine=edyn_gcomp_Init, rc=rc) - call edyn_esmf_chkerr(subname, 'ESMF_GridCompSetEntryPoint init', rc) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - userRoutine=edyn_gcomp_Run, rc=rc) - call edyn_esmf_chkerr(subname, 'ESMF_GridCompSetEntryPoint run', rc) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - userRoutine=edyn_gcomp_Final, rc=rc) - call edyn_esmf_chkerr(subname, 'ESMF_GridCompSetEntryPoint final', rc) - - end subroutine edyn_gcomp_SetServices - - subroutine edyn_grid_comp_init(mpi_comm) - use mpi, only: MPI_INTEGER - use ESMF, only: ESMF_StateCreate, ESMF_GridCompInitialize - use ESMF, only: ESMF_GridCompCreate, ESMF_GridCompSetServices - use ESMF, only: ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet - use cam_instance, only: inst_index, inst_name - use edyn_esmf, only: edyn_esmf_chkerr - - ! Dummy argument - integer, intent(in) :: mpi_comm - ! Local variables - integer, allocatable :: petlist(:) - integer :: iam - integer :: npes - integer :: localPet - integer :: petCount - integer :: rc - type(ESMF_VM) :: vm_init - character(len=*), parameter :: subname = 'edyn_grid_comp_init' - - !! Gather PE information for this instance - call ESMF_VMGetCurrent(vm_init, rc=rc) - call edyn_esmf_chkerr(subname, 'ESMF_VMGetCurrent', rc) - call ESMF_VMGet(vm_init, localPet=localPet, petCount=petCount) - call edyn_esmf_chkerr(subname, 'ESMF_VMGet', rc) - call mpi_comm_size(mpi_comm, npes, rc) - call mpi_comm_rank(mpi_comm, iam, rc) - ! Collect all the PETS for each instance for phys grid - allocate(petlist(npes)) - call mpi_allgather(localPet, 1, MPI_INTEGER, petlist, 1, MPI_INTEGER, mpi_comm, rc) - ! Now, we should be able to create a gridded component - phys_comp = ESMF_GridCompCreate(name=trim(inst_name), petList=petlist, rc=rc) - call edyn_esmf_chkerr(subname, 'ESMF_GridCompCreate '//trim(inst_name), rc) - call ESMF_GridCompSetServices(phys_comp, edyn_gcomp_SetServices, rc=rc) - call edyn_esmf_chkerr(subname, 'ESMF_GridCompSetServices '//trim(inst_name), rc) - ! Initialize the required component arguments - call ESMF_GridCompInitialize(phys_comp, rc=rc) - call edyn_esmf_chkerr(subname, 'ESMF_GridCompInitialize', rc) - - end subroutine edyn_grid_comp_init - - subroutine edyn_grid_comp_run1(ionos_epotential_model_in, & - cols, cole, efx_phys, kev_phys, amie_in, ltr_in) - - use ESMF, only: ESMF_GridCompRun - use edyn_esmf, only: edyn_esmf_chkerr - - ! Dummy arguments - character(len=*), intent(in) :: ionos_epotential_model_in - integer, optional, intent(in) :: cols - integer, optional, intent(in) :: cole - real(r8), optional, target, intent(out) :: efx_phys(:) - real(r8), optional, target, intent(out) :: kev_phys(:) - logical, optional, intent(in) :: amie_in - logical, optional, intent(in) :: ltr_in - - ! Local variables - integer :: rc - character(len=*), parameter :: subname = 'edyn_grid_comp_run1' - logical :: args_present(6) - - do_run = 1 - args_present(:) = (/ present(cols), present(cole), present(efx_phys), present(kev_phys), & - present(amie_in), present(ltr_in) /) - - if ( any( args_present ) ) then - if (.not. all( args_present ) ) then - call endrun(subname//': all optional arguments must be present for AMIE/LTR') - endif - - ionos_epotential_amie = amie_in - ionos_epotential_ltr = ltr_in - prescr_efx_phys => efx_phys - prescr_kev_phys => kev_phys - col_start = cols - col_end = cole - else - ! No else check assume no optional arguments are passed - nullify(prescr_efx_phys) - nullify(prescr_kev_phys) - end if - ionos_epotential_model = ionos_epotential_model_in - call ESMF_GridCompRun(phys_comp, rc=rc) - call edyn_esmf_chkerr(subname, 'ESMF_GridCompRun', rc) - - end subroutine edyn_grid_comp_run1 - - subroutine edyn_grid_comp_run2(omega_blck_in, pmid_blck_in, zi_blck_in, & - hi_blck_in, u_blck_in, v_blck_in, tn_blck_in, sigma_ped_blck_in, & - sigma_hall_blck_in, te_blck_in, ti_blck_in, mbar_blck_in, & - n2mmr_blck_in, o2mmr_blck_in, o1mmr_blck_in, o2pmmr_blck_in, & - nopmmr_blck_in, n2pmmr_blck_in, opmmr_blck_in, opmmrtm1_blck_in, & - ui_blck_in, vi_blck_in, wi_blck_in, rmassO2p_in, rmassNOp_in, & - rmassN2p_in, rmassOp_in, cols, cole, pver) - use ESMF, only: ESMF_GridCompRun - use edyn_esmf, only: edyn_esmf_chkerr - - ! Dummy arguments - real(r8), pointer :: omega_blck_in(:,:) - real(r8), pointer :: pmid_blck_in(:,:) - real(r8), pointer :: zi_blck_in(:,:) - real(r8), pointer :: hi_blck_in(:,:) - real(r8), pointer :: u_blck_in(:,:) - real(r8), pointer :: v_blck_in(:,:) - real(r8), pointer :: tn_blck_in(:,:) - real(r8), pointer :: sigma_ped_blck_in(:,:) - real(r8), pointer :: sigma_hall_blck_in(:,:) - real(r8), pointer :: te_blck_in(:,:) - real(r8), pointer :: ti_blck_in(:,:) - real(r8), pointer :: mbar_blck_in(:,:) - real(r8), pointer :: n2mmr_blck_in(:,:) - real(r8), pointer :: o2mmr_blck_in(:,:) - real(r8), pointer :: o1mmr_blck_in(:,:) - real(r8), pointer :: o2pmmr_blck_in(:,:) - real(r8), pointer :: nopmmr_blck_in(:,:) - real(r8), pointer :: n2pmmr_blck_in(:,:) - real(r8), pointer :: opmmr_blck_in(:,:) - real(r8), pointer :: opmmrtm1_blck_in(:,:) - real(r8), pointer :: ui_blck_in(:,:) - real(r8), pointer :: vi_blck_in(:,:) - real(r8), pointer :: wi_blck_in(:,:) - real(r8) :: rmassO2p_in - real(r8) :: rmassNOp_in - real(r8) :: rmassN2p_in - real(r8) :: rmassOp_in - integer, intent(in) :: cols - integer, intent(in) :: cole - integer, intent(in) :: pver - ! Local variables - integer :: rc - character(len=*), parameter :: subname = 'edyn_grid_comp_run2' - - do_run = 2 - omega_blck => omega_blck_in - pmid_blck => pmid_blck_in - zi_blck => zi_blck_in - hi_blck => hi_blck_in - u_blck => u_blck_in - v_blck => v_blck_in - tn_blck => tn_blck_in - sigma_ped_blck => sigma_ped_blck_in - sigma_hall_blck => sigma_hall_blck_in - te_blck => te_blck_in - ti_blck => ti_blck_in - mbar_blck => mbar_blck_in - n2mmr_blck => n2mmr_blck_in - o2mmr_blck => o2mmr_blck_in - o1mmr_blck => o1mmr_blck_in - o2pmmr_blck => o2pmmr_blck_in - nopmmr_blck => nopmmr_blck_in - n2pmmr_blck => n2pmmr_blck_in - opmmr_blck => opmmr_blck_in - opmmrtm1_blck => opmmrtm1_blck_in - ui_blck => ui_blck_in - vi_blck => vi_blck_in - wi_blck => wi_blck_in - rmassO2p = rmassO2p_in - rmassNOp = rmassNOp_in - rmassN2p = rmassN2p_in - rmassOp = rmassOp_in - col_start = cols - col_end = cole - nlev = pver - call ESMF_GridCompRun(phys_comp, rc=rc) - call edyn_esmf_chkerr(subname, 'ESMF_GridCompRun', rc) - - end subroutine edyn_grid_comp_run2 - - subroutine edyn_grid_comp_final() - use ESMF, only: ESMF_GridCompFinalize - use edyn_esmf, only: edyn_esmf_chkerr - - ! Local variables - integer :: rc - character(len=*), parameter :: subname = 'edyn_grid_comp_final' - - call ESMF_GridCompFinalize(phys_comp, rc=rc) - call edyn_esmf_chkerr(subname, 'ESMF_GridCompInitialize', rc) - - end subroutine edyn_grid_comp_final - - -end module edyn_grid_comp diff --git a/src/ionosphere/waccmx/edyn_init.F90 b/src/ionosphere/waccmx/edyn_init.F90 index 074fbe7e85..84750fbd59 100644 --- a/src/ionosphere/waccmx/edyn_init.F90 +++ b/src/ionosphere/waccmx/edyn_init.F90 @@ -23,7 +23,7 @@ subroutine edynamo_init(mpicomm,ionos_debug_hist) use edyn_maggrid, only: set_maggrid, gmlat, nmlonp1, nmlat, nmlath, nmlev use edyn_mpi, only: mp_exchange_tasks use edyn_mpi, only: mp_distribute_mag - use edyn_grid_comp, only: edyn_grid_comp_init + use edyn_phys_grid, only: edyn_phys_grid_init use edyn_solve, only: edyn_solve_init ! @@ -47,7 +47,8 @@ subroutine edynamo_init(mpicomm,ionos_debug_hist) call mp_exchange_tasks(mpicomm, 0, gmlat) ! single arg is iprint call alloc_edyn() ! allocate dynamo arrays - call edyn_grid_comp_init(mpicomm) + + call edyn_phys_grid_init() call add_fields() ! add fields to WACCM history master list diff --git a/src/ionosphere/waccmx/edyn_phys_grid.F90 b/src/ionosphere/waccmx/edyn_phys_grid.F90 new file mode 100644 index 0000000000..1c8cf8d7f9 --- /dev/null +++ b/src/ionosphere/waccmx/edyn_phys_grid.F90 @@ -0,0 +1,172 @@ +!------------------------------------------------------------------------------- +! Initializes the CAM physics grid mesh +!------------------------------------------------------------------------------- +module edyn_phys_grid + use shr_kind_mod, only: r8 => shr_kind_r8, cs=>shr_kind_cs, cl=>shr_kind_cl + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + + implicit none + + private + + public :: edyn_phys_grid_init + +contains + + subroutine edyn_phys_grid_init() + use ESMF, only: ESMF_DistGrid, ESMF_DistGridCreate, ESMF_MeshCreate + use ESMF, only: ESMF_FILEFORMAT_ESMFMESH,ESMF_MeshGet,ESMF_Mesh + use phys_control, only: phys_getopts + use phys_grid, only: get_ncols_p, get_gcol_p, get_rlon_all_p, get_rlat_all_p + use ppgrid, only: begchunk, endchunk + use edyn_esmf, only: edyn_esmf_chkerr, edyn_esmf_update_phys_mesh + use shr_const_mod,only: shr_const_pi + use ppgrid, only: pcols + use error_messages,only: alloc_err + + ! Local variables + integer :: ncols + integer :: chnk, col, dindex + integer, allocatable :: decomp(:) + character(len=cl) :: grid_file + character(len=*), parameter :: subname = 'edyn_gcomp_init' + real(r8) , parameter :: radtodeg = 180.0_r8/shr_const_pi + integer :: spatialDim + integer :: numOwnedElements + real(r8), pointer :: ownedElemCoords(:) + real(r8), pointer :: lat(:), latMesh(:) + real(r8), pointer :: lon(:), lonMesh(:) + real(r8) :: lats(pcols) ! array of chunk latitudes + real(r8) :: lons(pcols) ! array of chunk longitude + integer :: i, c, n + character(len=cs) :: tempc1,tempc2 + character(len=300) :: errstr + + ! dist_grid_2d: DistGrid for 2D fields + type(ESMF_DistGrid) :: dist_grid_2d + + ! phys_mesh: Local copy of physics grid + type(ESMF_Mesh) :: phys_mesh + + real(r8), parameter :: abstol = 1.e-6_r8 + integer :: total_cols, rc + + ! Find the physics grid file + call phys_getopts(physics_grid_out=grid_file) + ! Compute the local decomp + total_cols = 0 + do chnk = begchunk, endchunk + total_cols = total_cols + get_ncols_p(chnk) + end do + allocate(decomp(total_cols), stat=rc) + call alloc_err(rc,subname,'decomp',total_cols) + + dindex = 0 + do chnk = begchunk, endchunk + ncols = get_ncols_p(chnk) + do col = 1, ncols + dindex = dindex + 1 + decomp(dindex) = get_gcol_p(chnk, col) + end do + end do + + ! Create a DistGrid based on the physics decomp + dist_grid_2d = ESMF_DistGridCreate(arbSeqIndexList=decomp, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_DistGridCreate phys decomp', rc) + + ! Create an ESMF_mesh for the physics decomposition + phys_mesh = ESMF_MeshCreate(trim(grid_file), ESMF_FILEFORMAT_ESMFMESH, & + elementDistgrid=dist_grid_2d, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_MeshCreateFromFile', rc) + + call edyn_esmf_update_phys_mesh(phys_mesh) + + ! Check that the mesh coordinates are consistent with the model physics column coordinates + + ! obtain mesh lats and lons + call ESMF_MeshGet(phys_mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_MeshGet', rc) + + if (numOwnedElements /= total_cols) then + write(tempc1,'(i10)') numOwnedElements + write(tempc2,'(i10)') total_cols + call endrun(trim(subname)//": ERROR numOwnedElements "// & + trim(tempc1) //" not equal to local size "// trim(tempc2)) + end if + + allocate(ownedElemCoords(spatialDim*numOwnedElements), stat=rc) + call alloc_err(rc,subname,'ownedElemCoords',spatialDim*numOwnedElements) + + allocate(lonMesh(total_cols), stat=rc) + call alloc_err(rc,subname,'lonMesh',total_cols) + + allocate(latMesh(total_cols), stat=rc) + call alloc_err(rc,subname,'latMesh',total_cols) + + call ESMF_MeshGet(phys_mesh, ownedElemCoords=ownedElemCoords) + + do n = 1,total_cols + lonMesh(n) = ownedElemCoords(2*n-1) + latMesh(n) = ownedElemCoords(2*n) + end do + + ! obtain internally generated cam lats and lons + allocate(lon(total_cols), stat=rc); + call alloc_err(rc,subname,'lon',total_cols) + + lon(:) = 0._r8 + + allocate(lat(total_cols), stat=rc); + call alloc_err(rc,subname,'lat',total_cols) + + lat(:) = 0._r8 + + n=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + ! latitudes and longitudes returned in radians + call get_rlat_all_p(c, ncols, lats) + call get_rlon_all_p(c, ncols, lons) + do i=1,ncols + n = n+1 + lat(n) = lats(i)*radtodeg + lon(n) = lons(i)*radtodeg + end do + end do + + errstr = '' + ! error check differences between internally generated lons and those read in + do n = 1,total_cols + if (abs(lonMesh(n) - lon(n)) > abstol) then + if ( (abs(lonMesh(n)-lon(n)) > 360._r8+abstol) .or. (abs(lonMesh(n)-lon(n)) < 360._r8-abstol) ) then + write(errstr,100) n,lon(n),lonMesh(n), abs(lonMesh(n)-lon(n)) + write(iulog,*) trim(errstr) + endif + end if + if (abs(latMesh(n) - lat(n)) > abstol) then + ! poles in the 4x5 SCRIP file seem to be off by 1 degree + if (.not.( (abs(lat(n))>88.0_r8) .and. (abs(latMesh(n))>88.0_r8) )) then + write(errstr,101) n,lat(n),latMesh(n), abs(latMesh(n)-lat(n)) + write(iulog,*) trim(errstr) + endif + end if + end do + + if ( len_trim(errstr) > 0 ) then + call endrun(subname//': physics mesh coords do not match model coords') + end if + + ! deallocate memory + deallocate(ownedElemCoords) + deallocate(lon, lonMesh) + deallocate(lat, latMesh) + deallocate(decomp) + +100 format('edyn_gcomp_init: coord mismatch... n, lon(n), lonmesh(n), diff_lon = ',i6,2(f21.13,3x),d21.5) +101 format('edyn_gcomp_init: coord mismatch... n, lat(n), latmesh(n), diff_lat = ',i6,2(f21.13,3x),d21.5) + + end subroutine edyn_phys_grid_init + + +end module edyn_phys_grid diff --git a/src/ionosphere/waccmx/ionosphere_interface.F90 b/src/ionosphere/waccmx/ionosphere_interface.F90 index 7579dfcde3..fa5752f024 100644 --- a/src/ionosphere/waccmx/ionosphere_interface.F90 +++ b/src/ionosphere/waccmx/ionosphere_interface.F90 @@ -6,6 +6,8 @@ module ionosphere_interface use phys_grid, only: get_ncols_p use dpie_coupling, only: d_pie_init + use dpie_coupling, only: d_pie_epotent + use dpie_coupling, only: d_pie_coupling ! WACCM-X ionosphere/electrodynamics coupling use short_lived_species, only: slvd_index, slvd_pbf_ndx => pbf_idx ! Routines to access short lived species use chem_mods, only: adv_mass ! Array holding mass values for short lived species @@ -20,6 +22,7 @@ module ionosphere_interface use pio, only: var_desc_t use perf_mod, only: t_startf, t_stopf use epotential_params, only: epot_active, epot_crit_colats + use shr_const_mod, only: SHR_CONST_REARTH ! meters implicit none @@ -95,6 +98,8 @@ module ionosphere_interface integer :: mag_nlon=0, mag_nlat=0, mag_nlev=0, mag_ngrid=0 + real(r8), parameter :: rearth_inv = 1._r8/SHR_CONST_REARTH ! /meters + contains !--------------------------------------------------------------------------- @@ -392,8 +397,6 @@ end subroutine ionosphere_init subroutine ionosphere_run1(pbuf2d) use physics_buffer, only: physics_buffer_desc use cam_history, only: outfld, write_inithist - ! Gridded component call - use edyn_grid_comp, only: edyn_grid_comp_run1 ! args type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -427,7 +430,7 @@ subroutine ionosphere_run1(pbuf2d) allocate(prescr_kev(blksize)) ! data assimilated potential - call edyn_grid_comp_run1(ionos_epotential_model, & + call d_pie_epotent(ionos_epotential_model, epot_crit_colats, & cols=1, cole=blksize, efx_phys=prescr_efx, kev_phys=prescr_kev, & amie_in=ionos_epotential_amie, ltr_in=ionos_epotential_ltr ) @@ -464,7 +467,7 @@ subroutine ionosphere_run1(pbuf2d) ! set cross tail potential before physics -- ! aurora uses weimer derived potential - call edyn_grid_comp_run1(ionos_epotential_model) + call d_pie_epotent( ionos_epotential_model, epot_crit_colats ) end if prescribed_epot @@ -477,10 +480,7 @@ subroutine ionosphere_run2(phys_state, pbuf2d) use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc use cam_history, only: outfld, write_inithist, hist_fld_active - ! Gridded component call - use edyn_grid_comp, only: edyn_grid_comp_run2 use shr_assert_mod, only: shr_assert_in_domain - use shr_const_mod, only: SHR_CONST_REARTH ! meters ! - pull some fields from pbuf and dyn_in ! - invoke ionosphere/electro-dynamics coupling @@ -546,7 +546,6 @@ subroutine ionosphere_run2(phys_state, pbuf2d) real(r8) :: r8tmp real(r8), pointer :: tempm(:,:) => null() ! Temp midpoint field for outfld real(r8), pointer :: tempi(:,:) => null() ! Temp interface field for outfld - real(r8), parameter :: rearth_inv = 1._r8/SHR_CONST_REARTH ! /meters real(r8), parameter :: n2min = 1.e-6_r8 ! lower limit of N2 mixing ratios character(len=*), parameter :: subname = 'ionosphere_run2' @@ -740,8 +739,8 @@ subroutine ionosphere_run2(phys_state, pbuf2d) ! Might need geometric height on midpoints for output !------------------------------------------------------------ if (hist_fld_active('Z3GM')) then - r8tmp = phys_state(lchnk)%zm(i, k) + phis(i)*rga - tempm(i, k) = r8tmp * (1._r8 + (r8tmp * rearth_inv)) + ! geometric altitude (meters above sea level) + tempm(i,k) = geometric_hgt(zgp=phys_state(lchnk)%zm(i,k), zsf=phis(i)*rga) end if ! physics state fields on interfaces (but only to pver) zi_blck(k, j) = phys_state(lchnk)%zi(i, k) + phis(i)*rga @@ -750,9 +749,9 @@ subroutine ionosphere_run2(phys_state, pbuf2d) !------------------------------------------------------------ ! Note: zht is pver instead of pverp because dynamo does not ! use bottom interface - hi_blck(k, j) = zi_blck(k, j) * (1._r8 + (zi_blck(k, j) * rearth_inv)) + hi_blck(k,j) = geometric_hgt(zgp=phys_state(lchnk)%zi(i,k), zsf=phis(i)*rga) if (hist_fld_active('Z3GMI')) then - tempi(i, k) = hi_blck(k, j) + tempi(i,k) = hi_blck(k, j) end if omega_blck(k, j) = phys_state(lchnk)%omega(i, k) tn_blck(k, j) = phys_state(lchnk)%t(i, k) @@ -846,15 +845,16 @@ subroutine ionosphere_run2(phys_state, pbuf2d) ! Compute geometric height and some diagnostic fields needed by ! the dynamo. Output some fields from physics grid ! This code is inside the timer as it is part of the coupling -! + ! ! waccmx ionosphere electro-dynamics -- transports O+ and ! provides updates to ion drift velocities (on physics grid) ! All fields are on physics mesh, (pver, blksize), ! where blksize is the total number of columns on this task - call edyn_grid_comp_run2(omega_blck, pmid_blck, zi_blck, hi_blck, & + + call d_pie_coupling(omega_blck, pmid_blck, zi_blck, hi_blck, & u_blck, v_blck, tn_blck, sigma_ped_blck, sigma_hall_blck, & - te_blck, ti_blck, mbar_blck, n2mmr_blck, o2mmr_blck, o1mmr_blck, & - o2pmmr_blck, nopmmr_blck, n2pmmr_blck, & + te_blck, ti_blck, mbar_blck, n2mmr_blck, o2mmr_blck, & + o1mmr_blck, o2pmmr_blck, nopmmr_blck, n2pmmr_blck, & opmmr_blck, opmmrtm1_blck, ui_blck, vi_blck, wi_blck, & rmassO2p, rmassNOp, rmassN2p, rmassOp, 1, blksize, pver) @@ -1164,5 +1164,24 @@ end subroutine ionosphere_alloc !========================================================================== + ! calculates geometric height (meters above sea level) + pure function geometric_hgt( zgp, zsf ) result(zgm) + + real(r8), intent(in) :: zgp ! geopotential height (m) + real(r8), intent(in) :: zsf ! surface height above sea level (m) + real(r8) :: zgm ! geometric height above sea level (m) + + real(r8) :: tmp + + ! Hanli's formulation: + ! Z_gm = 1/(1 - (1+Zs/r) * Z_gp/r) * (Zs + (1+Zs/r) * Z_gp) + ! Z_gm: geometric height + ! Zs: Surface height + ! Z_gp: model calculated geopotential height (zm and zi in the model) + + tmp = 1._r8+zsf*rearth_inv + zgm = (zsf + tmp*zgp) / (1._r8 - tmp*zgp*rearth_inv) + + end function geometric_hgt end module ionosphere_interface diff --git a/src/ionosphere/waccmx/wei05sc.F90 b/src/ionosphere/waccmx/wei05sc.F90 index e3c32b0743..afc56440ed 100644 --- a/src/ionosphere/waccmx/wei05sc.F90 +++ b/src/ionosphere/waccmx/wei05sc.F90 @@ -1126,7 +1126,7 @@ real(r8) function km_n(m,rn) return end if rm = real(m, r8) - km_n = sqrt(2._r8*exp(lngamma(rn+rm+1._r8)-lngamma(rn-rm+1._r8))) / & + km_n = sqrt(2._r8*exp(log_gamma(rn+rm+1._r8)-log_gamma(rn-rm+1._r8))) / & (2._r8**m*factorial(m)) end function km_n !----------------------------------------------------------------------- @@ -1296,32 +1296,6 @@ integer function value_locate(vec,val) end if end do end function value_locate -!----------------------------------------------------------------------- - real(r8) function lngamma(xx) - ! - ! This is an f90 translation from C code copied from - ! gammln routine from "Numerical Recipes in C" Chapter 6.1. - ! see: http://numerical.recipes - ! - - real(r8), intent(in) :: xx - real(r8) :: x,y,tmp,ser - real(r8) :: cof(6) = (/76.18009172947146_r8, -86.50532032941677_r8, & - 24.01409824083091_r8, -1.231739572450155_r8, & - 0.1208650973866179e-2_r8, -0.5395239384953e-5_r8/) - integer :: j - ! - y = xx - x = xx - tmp = x+5.5_r8 - tmp = tmp-(x + 0.5_r8) * log(tmp) - ser = 1.000000000190015_r8 - do j = 1, 5 - y = y + 1 - ser = ser + (cof(j) / y) - end do - lngamma = -tmp+log(2.5066282746310005_r8*ser/x) - end function lngamma !----------------------------------------------------------------------- real(r8) function factorial(n) integer,intent(in) :: n diff --git a/src/physics/ali_arms b/src/physics/ali_arms new file mode 160000 index 0000000000..825e7f20e2 --- /dev/null +++ b/src/physics/ali_arms @@ -0,0 +1 @@ +Subproject commit 825e7f20e2dd368b95b1e3cb2562ab571318bb4d diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 index a81e1d4701..c6ae7affcd 100644 --- a/src/physics/cam/aerosol_optics_cam.F90 +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -1,3 +1,5 @@ +#define _881FIX_ +#define _945FIX_ module aerosol_optics_cam use shr_kind_mod, only: r8 => shr_kind_r8 use shr_kind_mod, only: cl => shr_kind_cl @@ -36,12 +38,21 @@ module aerosol_optics_cam public :: aerosol_optics_cam_sw public :: aerosol_optics_cam_lw +#ifdef _945FIX_ + type aero_props_t + type(modal_aerosol_properties), pointer :: obj => null() + end type aero_props_t + type aero_state_t + type(modal_aerosol_state), pointer :: obj => null() + end type aero_state_t +#else type aero_props_t class(aerosol_properties), pointer :: obj => null() end type aero_props_t type aero_state_t class(aerosol_state), pointer :: obj => null() end type aero_state_t +#endif type(aero_props_t), allocatable :: aero_props(:) ! array of aerosol properties objects to allow for ! multiple aerosol representations in the same sim @@ -852,33 +863,63 @@ subroutine update_diags case('dust') dustvol(icol) = vol(icol) burdendust(icol) = burdendust(icol) + specmmr(icol,ilev)*mass(icol,ilev) +#ifdef _881FIX_ + scatdust(icol) = vol(icol) * DBLE(specrefindex(iwav)) + absdust(icol) =-vol(icol) * DIMAG(specrefindex(iwav)) +#else scatdust(icol) = vol(icol) * specrefindex(iwav)%re absdust(icol) =-vol(icol) * specrefindex(iwav)%im +#endif hygrodust(icol)= vol(icol)*hygro_aer case('black-c') burdenbc(icol) = burdenbc(icol) + specmmr(icol,ilev)*mass(icol,ilev) +#ifdef _881FIX_ + scatbc(icol) = vol(icol) * DBLE(specrefindex(iwav)) + absbc(icol) =-vol(icol) * DIMAG(specrefindex(iwav)) +#else scatbc(icol) = vol(icol) * specrefindex(iwav)%re absbc(icol) =-vol(icol) * specrefindex(iwav)%im +#endif hygrobc(icol)= vol(icol)*hygro_aer case('sulfate') burdenso4(icol) = burdenso4(icol) + specmmr(icol,ilev)*mass(icol,ilev) +#ifdef _881FIX_ + scatsulf(icol) = vol(icol) * DBLE(specrefindex(iwav)) + abssulf(icol) =-vol(icol) * DIMAG(specrefindex(iwav)) +#else scatsulf(icol) = vol(icol) * specrefindex(iwav)%re abssulf(icol) =-vol(icol) * specrefindex(iwav)%im +#endif hygrosulf(icol)= vol(icol)*hygro_aer case('p-organic') burdenpom(icol) = burdenpom(icol) + specmmr(icol,ilev)*mass(icol,ilev) +#ifdef _881FIX_ + scatpom(icol) = vol(icol) * DBLE(specrefindex(iwav)) + abspom(icol) =-vol(icol) * DIMAG(specrefindex(iwav)) +#else scatpom(icol) = vol(icol) * specrefindex(iwav)%re abspom(icol) =-vol(icol) * specrefindex(iwav)%im +#endif hygropom(icol)= vol(icol)*hygro_aer case('s-organic') burdensoa(icol) = burdensoa(icol) + specmmr(icol,ilev)*mass(icol,ilev) +#ifdef _881FIX_ + scatsoa(icol) = vol(icol) * DBLE(specrefindex(iwav)) + abssoa(icol) =-vol(icol) * DIMAG(specrefindex(iwav)) +#else scatsoa(icol) = vol(icol) * specrefindex(iwav)%re abssoa(icol) = -vol(icol) * specrefindex(iwav)%im +#endif hygrosoa(icol)= vol(icol)*hygro_aer case('seasalt') burdenseasalt(icol) = burdenseasalt(icol) + specmmr(icol,ilev)*mass(icol,ilev) +#ifdef _881FIX_ + scatsslt(icol) = vol(icol) * DBLE(specrefindex(iwav)) + abssslt(icol) =-vol(icol) * DIMAG(specrefindex(iwav)) +#else scatsslt(icol) = vol(icol) * specrefindex(iwav)%re abssslt(icol) = -vol(icol) * specrefindex(iwav)%im +#endif hygrosslt(icol)= vol(icol)*hygro_aer end select end do @@ -890,8 +931,13 @@ subroutine update_diags ! partition optical depth into contributions from each constituent ! assume contribution is proportional to refractive index X volume +#ifdef _881FIX_ + scath2o = watervol(icol,ilev)*DBLE(crefwsw(iwav)) + absh2o = -watervol(icol,ilev)*DIMAG(crefwsw(iwav)) +#else scath2o = watervol(icol,ilev)*crefwsw(iwav)%re absh2o = -watervol(icol,ilev)*crefwsw(iwav)%im +#endif sumscat = scatsulf(icol) + scatpom(icol) + scatsoa(icol) + scatbc(icol) + & scatdust(icol) + scatsslt(icol) + scath2o sumabs = abssulf(icol) + abspom(icol) + abssoa(icol) + absbc(icol) + & diff --git a/src/physics/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90 index 392c7a285c..9c16325357 100644 --- a/src/physics/cam/cam_diagnostics.F90 +++ b/src/physics/cam/cam_diagnostics.F90 @@ -501,6 +501,8 @@ subroutine diag_init_moist(pbuf2d) call addfld ('TREFHTMX', horiz_only, 'X','K','Maximum reference height temperature over output period') call addfld ('QREFHT', horiz_only, 'A', 'kg/kg','Reference height humidity') call addfld ('U10', horiz_only, 'A', 'm/s','10m wind speed') + call addfld ('UGUST', horiz_only, 'A', 'm/s','Gustiness term added to U10') + call addfld ('U10WITHGUSTS',horiz_only, 'A', 'm/s','10m wind speed with gustiness added') call addfld ('RHREFHT', horiz_only, 'A', 'fraction','Reference height relative humidity') call addfld ('LANDFRAC', horiz_only, 'A', 'fraction','Fraction of sfc area covered by land') @@ -1785,6 +1787,9 @@ subroutine diag_surf (cam_in, cam_out, state, pbuf) call outfld('TREFHTMN', cam_in%tref, pcols, lchnk) call outfld('QREFHT', cam_in%qref, pcols, lchnk) call outfld('U10', cam_in%u10, pcols, lchnk) + call outfld('UGUST', cam_in%ugustOut, pcols, lchnk) + call outfld('U10WITHGUSTS',cam_in%u10withGusts, pcols, lchnk) + ! ! Calculate and output reference height RH (RHREFHT) call qsat(cam_in%tref(1:ncol), state%ps(1:ncol), tem2(1:ncol), ftem(1:ncol), ncol) diff --git a/src/physics/cam/cam_snapshot.F90 b/src/physics/cam/cam_snapshot.F90 index 92f25d775c..7e7d83e9ef 100644 --- a/src/physics/cam/cam_snapshot.F90 +++ b/src/physics/cam/cam_snapshot.F90 @@ -58,7 +58,7 @@ subroutine cam_snapshot_init(cam_in_arr, cam_out_arr, pbuf, index) call phys_getopts(cam_snapshot_before_num_out = cam_snapshot_before_num, & cam_snapshot_after_num_out = cam_snapshot_after_num) - + ! Return if not turned on if (cam_snapshot_before_num <= 0 .and. cam_snapshot_after_num <= 0) return ! No snapshot files are being requested @@ -76,7 +76,7 @@ subroutine cam_snapshot_init(cam_in_arr, cam_out_arr, pbuf, index) end subroutine cam_snapshot_init subroutine cam_snapshot_all_outfld_tphysbc(file_num, state, tend, cam_in, cam_out, pbuf, flx_heat, cmfmc, cmfcme, & - pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) use time_manager, only: is_first_step, is_first_restart_step @@ -95,7 +95,6 @@ subroutine cam_snapshot_all_outfld_tphysbc(file_num, state, tend, cam_in, cam_ou real(r8), intent(in) :: flx_heat(:) ! Heat flux for check_energy_chng. real(r8), intent(in) :: cmfmc(:,:) ! convective mass flux real(r8), intent(in) :: cmfcme(:,:) ! cmf condensation - evaporation - real(r8), intent(in) :: pflx(:,:) ! convective rain flux throughout bottom of level real(r8), intent(in) :: zdu(:,:) ! detraining mass flux from deep convection real(r8), intent(in) :: rliq(:) ! vertical integral of liquid not yet in q(ixcldliq) real(r8), intent(in) :: rice(:) ! vertical integral of ice not yet in q(ixcldice) @@ -111,7 +110,7 @@ subroutine cam_snapshot_all_outfld_tphysbc(file_num, state, tend, cam_in, cam_ou ! Return if the first timestep as not all fields may be filled in and this will cause a core dump if (is_first_step().or. is_first_restart_step()) return - ! Return if not turned on + ! Return if not turned on if (cam_snapshot_before_num <= 0 .and. cam_snapshot_after_num <= 0) return ! No snapshot files are being requested lchnk = state%lchnk @@ -119,7 +118,6 @@ subroutine cam_snapshot_all_outfld_tphysbc(file_num, state, tend, cam_in, cam_ou call outfld('tphysbc_flx_heat', flx_heat, pcols, lchnk) call outfld('tphysbc_cmfmc', cmfmc, pcols, lchnk) call outfld('tphysbc_cmfcme', cmfcme, pcols, lchnk) - call outfld('tphysbc_pflx', pflx, pcols, lchnk) call outfld('tphysbc_zdu', zdu, pcols, lchnk) call outfld('tphysbc_rliq', rliq, pcols, lchnk) call outfld('tphysbc_rice', rice, pcols, lchnk) @@ -160,7 +158,7 @@ subroutine cam_snapshot_all_outfld_tphysac(file_num, state, tend, cam_in, cam_ou ! Return if the first timestep as not all fields may be filled in and this will cause a core dump if (is_first_step()) return - ! Return if not turned on + ! Return if not turned on if (cam_snapshot_before_num <= 0 .and. cam_snapshot_after_num <= 0) return ! No snapshot files are being requested lchnk = state%lchnk @@ -182,7 +180,7 @@ subroutine cam_tphysbc_snapshot_init(cam_snapshot_before_num, cam_snapshot_after !-------------------------------------------------------- integer,intent(in) :: cam_snapshot_before_num, cam_snapshot_after_num - + ntphysbc_var = 0 !-------------------------------------------------------- @@ -199,9 +197,6 @@ subroutine cam_tphysbc_snapshot_init(cam_snapshot_before_num, cam_snapshot_after call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & 'cmfcme', 'tphysbc_cmfcme', 'unset', 'lev') - call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'pflx', 'tphysbc_pflx', 'unset', 'lev') - call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & 'zdu', 'tphysbc_zdu', 'unset', 'lev') @@ -240,7 +235,7 @@ subroutine cam_tphysac_snapshot_init(cam_snapshot_before_num, cam_snapshot_after !-------------------------------------------------------- integer,intent(in) :: cam_snapshot_before_num, cam_snapshot_after_num - + ntphysac_var = 0 !-------------------------------------------------------- diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 7615f0e432..1410a52a2f 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -485,13 +485,14 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & ! if (state%psetcols == pcols) then cp_or_cv(:ncol,:) = cp_or_cv_dycore(:ncol,:,lchnk) + scaling(:ncol,:) = cpairv(:ncol,:,lchnk)/cp_or_cv_dycore(:ncol,:,lchnk) else cp_or_cv(:ncol,:) = cpair + scaling(:ncol,:) = 1.0_r8 endif ! ! enthalpy scaling for energy consistency ! - scaling(:ncol,:) = cpairv(:ncol,:,lchnk)/cp_or_cv_dycore(:ncol,:,lchnk) temp(1:ncol,:) = state%temp_ini(1:ncol,:)+scaling(1:ncol,:)*(state%T(1:ncol,:)-state%temp_ini(1:ncol,:)) call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst),.true., & state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & diff --git a/src/physics/cam/cloud_diagnostics.F90 b/src/physics/cam/cloud_diagnostics.F90 index f7a5115914..b3488bec60 100644 --- a/src/physics/cam/cloud_diagnostics.F90 +++ b/src/physics/cam/cloud_diagnostics.F90 @@ -8,7 +8,7 @@ module cloud_diagnostics ! ! Author: Byron Boville Sept 06, 2002 ! Modified Oct 15, 2008 -! +! ! !--------------------------------------------------------------------------------- @@ -32,7 +32,7 @@ module cloud_diagnostics logical :: do_cld_diag, mg_clouds, rk_clouds, camrt_rad, spcam_m2005_clouds, spcam_sam1mom_clouds logical :: one_mom_clouds, two_mom_clouds - + integer :: cicewp_idx = -1 integer :: cliqwp_idx = -1 integer :: cldemis_idx = -1 @@ -82,15 +82,18 @@ subroutine cloud_diagnostics_register end subroutine cloud_diagnostics_register !=============================================================================== - subroutine cloud_diagnostics_init() + subroutine cloud_diagnostics_init(pbuf2d) !----------------------------------------------------------------------- - use physics_buffer,only: pbuf_get_index + use physics_buffer,only: pbuf_get_index, pbuf_set_field, physics_buffer_desc use phys_control, only: phys_getopts use constituents, only: cnst_get_ind use cloud_cover_diags, only: cloud_cover_diags_init + use time_manager, only: is_first_step implicit none + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + !----------------------------------------------------------------------- character(len=16) :: wpunits, sampling_seq @@ -105,13 +108,19 @@ subroutine cloud_diagnostics_init() if (two_mom_clouds) then + ! initialize to zero + if (is_first_step()) then + call pbuf_set_field(pbuf2d, iciwp_idx, 0._r8) + call pbuf_set_field(pbuf2d, iclwp_idx, 0._r8) + end if + call addfld ('ICWMR', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-cloud water mixing ratio') call addfld ('ICIMR', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-cloud ice mixing ratio' ) call addfld ('IWC', (/ 'lev' /), 'A', 'kg/m3', 'Grid box average ice water content' ) call addfld ('LWC', (/ 'lev' /), 'A', 'kg/m3', 'Grid box average liquid water content' ) ! determine the add_default fields - call phys_getopts(history_amwg_out = history_amwg) + call phys_getopts(history_amwg_out = history_amwg) if (history_amwg) then call add_default ('ICWMR', 1, ' ') @@ -136,11 +145,11 @@ subroutine cloud_diagnostics_init() do_cld_diag = one_mom_clouds .or. two_mom_clouds if (.not.do_cld_diag) return - - if (rk_clouds) then + + if (rk_clouds) then wpunits = 'gram/m2' sampling_seq='rad_lwsw' - else if (two_mom_clouds .or. spcam_sam1mom_clouds) then + else if (two_mom_clouds .or. spcam_sam1mom_clouds) then wpunits = 'kg/m2' sampling_seq='' end if @@ -157,7 +166,7 @@ subroutine cloud_diagnostics_init() sampling_seq=sampling_seq) call addfld ('TGCLDIWP',horiz_only, 'A',wpunits,'Total grid-box cloud ice water path' , & sampling_seq=sampling_seq) - + if(two_mom_clouds) then call addfld ('lambda_cloud',(/ 'lev' /),'I','1/meter','lambda in cloud') call addfld ('mu_cloud', (/ 'lev' /),'I','1','mu in cloud') @@ -208,10 +217,10 @@ subroutine cloud_diagnostics_calc(state, pbuf) ! ! Compute (liquid+ice) water path and cloud water/ice diagnostics ! *** soon this code will compute liquid and ice paths from input liquid and ice mixing ratios -! +! ! **** mixes interface and physics code temporarily !----------------------------------------------------------------------- - use physics_types, only: physics_state + use physics_types, only: physics_state use physics_buffer,only: physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx use pkg_cldoptics, only: cldovrlap, cldclw, cldems use conv_water, only: conv_water_in_rad, conv_water_4rad @@ -277,7 +286,7 @@ subroutine cloud_diagnostics_calc(state, pbuf) real(r8) :: effcld(pcols,pver) ! effective cloud=cld*emis logical :: dosw,dolw - + !----------------------------------------------------------------------- if (.not.do_cld_diag) return @@ -364,7 +373,7 @@ subroutine cloud_diagnostics_calc(state, pbuf) if( conv_water_in_rad /= 0 ) then allcld_ice(:ncol,:) = 0._r8 ! Grid-avg all cloud liquid allcld_liq(:ncol,:) = 0._r8 ! Grid-avg all cloud ice - + call conv_water_4rad(state, pbuf, allcld_liq, allcld_ice) else allcld_liq(:ncol,top_lev:pver) = state%q(:ncol,top_lev:pver,ixcldliq) ! Grid-ave all cloud liquid @@ -415,7 +424,7 @@ subroutine cloud_diagnostics_calc(state, pbuf) allcld_liq = state%q(:,:,ixcldliq) allcld_ice = state%q(:,:,ixcldice) end if - + do k=1,pver do i = 1,ncol gicewp(i,k) = allcld_ice(i,k)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. @@ -436,7 +445,7 @@ subroutine cloud_diagnostics_calc(state, pbuf) call cloud_cover_diags_out(lchnk, ncol, cld, state%pmid, nmxrgn, pmxrgn ) endif end if - + tgicewp(:ncol) = 0._r8 tgliqwp(:ncol) = 0._r8 @@ -453,14 +462,14 @@ subroutine cloud_diagnostics_calc(state, pbuf) ! Cloud emissivity. call cldems(lchnk, ncol, cwp, ficemr, rei, cldemis, cldtau) - + ! Effective cloud cover do k=1,pver do i=1,ncol effcld(i,k) = cld(i,k)*cldemis(i,k) end do end do - + call outfld('EFFCLD' ,effcld , pcols,lchnk) if (camrt_rad) then call outfld('EMIS' ,cldemis, pcols,lchnk) @@ -481,7 +490,7 @@ subroutine cloud_diagnostics_calc(state, pbuf) endif - if (.not. use_spcam) then + if (.not. use_spcam) then ! for spcam, these are diagnostics in crm_physics.F90 call outfld('GCLDLWP' ,gwp , pcols,lchnk) call outfld('TGCLDCWP',tgwp , pcols,lchnk) @@ -505,7 +514,7 @@ subroutine cloud_diagnostics_calc(state, pbuf) call cldclw(lchnk, ncol, state%zi, clwpold, tpw, hl) call outfld('SETLWP' ,clwpold, pcols,lchnk) call outfld('LWSH' ,hl , pcols,lchnk) - + if(one_mom_clouds) then if (cldemis_idx<0) deallocate(cldemis) if (cldtau_idx<0) deallocate(cldtau) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 1432be7327..06d70a98da 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -20,7 +20,7 @@ module clubb_intr use shr_kind_mod, only: r8=>shr_kind_r8 use ppgrid, only: pver, pverp, pcols, begchunk, endchunk use phys_control, only: phys_getopts - use physconst, only: cpair, gravit, rga, latvap, latice, zvir, rh2o + use physconst, only: cpair, gravit, rga, latvap, latice, zvir, rh2o, karman, pi use air_composition, only: rairv, cpairv use cam_history_support, only: max_fieldname_len @@ -28,26 +28,35 @@ module clubb_intr use constituents, only: pcnst, cnst_add use pbl_utils, only: calc_ustar, calc_obklen use ref_pres, only: top_lev => trop_cloud_top_lev + #ifdef CLUBB_SGS use clubb_api_module, only: pdf_parameter, implicit_coefs_terms - use clubb_api_module, only: clubb_config_flags_type, grid, stats, nu_vertical_res_dep + use clubb_api_module, only: clubb_config_flags_type, grid, stats, & + nu_vertical_res_dep, stats_metadata_type, & + hm_metadata_type, sclr_idx_type + use clubb_api_module, only: nparams use clubb_mf, only: do_clubb_mf, do_clubb_mf_diag use cloud_fraction, only: dp1, dp2 #endif implicit none + #ifdef CLUBB_SGS ! Variables that contains all the statistics - type (stats), target, save :: stats_zt(pcols), & ! stats_zt grid stats_zm(pcols), & ! stats_zm grid stats_rad_zt(pcols), & ! stats_rad_zt grid stats_rad_zm(pcols), & ! stats_rad_zm grid stats_sfc(pcols) ! stats_sfc - -!$omp threadprivate(stats_zt, stats_zm, stats_rad_zt, stats_rad_zm, stats_sfc) - + type (hm_metadata_type) :: & + hm_metadata + + type (stats_metadata_type) :: & + stats_metadata + + type (sclr_idx_type) :: & + sclr_idx #endif private @@ -61,6 +70,7 @@ module clubb_intr #ifdef CLUBB_SGS ! This utilizes CLUBB specific variables in its interface stats_init_clubb, & + stats_metadata, & stats_zt, stats_zm, stats_sfc, & stats_rad_zt, stats_rad_zm, & stats_end_timestep_clubb, & @@ -76,34 +86,55 @@ module clubb_intr logical, public :: do_cldcool logical :: clubb_do_icesuper + #ifdef CLUBB_SGS type(clubb_config_flags_type), public :: clubb_config_flags - real(r8), dimension(nparams), public :: clubb_params ! Adjustable CLUBB parameters (C1, C2 ...) + real(r8), dimension(nparams), public :: clubb_params_single_col ! Adjustable CLUBB parameters (C1, C2 ...) #endif + ! These are zero by default, but will be set by SILHS before they are used by subcolumns + integer :: & + hydromet_dim = 0, & + pdf_dim = 0 + + + ! ------------------------ ! + ! Sometimes private data ! + ! ------------------------ ! +#ifdef CLUBB_SGS +#ifdef SILHS + ! If SILHS is in use, it will initialize these + public :: & + hydromet_dim, & + pdf_dim, & + hm_metadata +#else + ! If SILHS is not in use, there is no need for them to be public + private :: & + hydromet_dim, & + pdf_dim, & + hm_metadata +#endif +#endif + ! ------------ ! ! Private data ! ! ------------ ! integer, parameter :: & grid_type = 3, & ! The 2 option specifies stretched thermodynamic levels - hydromet_dim = 0 ! The hydromet array in SAM-CLUBB is currently 0 elements + sclr_dim = 0 ! Higher-order scalars, set to zero ! Even though sclr_dim is set to 0, the dimension here is set to 1 to prevent compiler errors ! See github ticket larson-group/cam#133 for details real(r8), parameter, dimension(1) :: & sclr_tol = 1.e-8_r8 ! Total water in kg/kg - character(len=6) :: saturation_equation - real(r8), parameter :: & theta0 = 300._r8, & ! Reference temperature [K] ts_nudge = 86400._r8, & ! Time scale for u/v nudging (not used) [s] p0_clubb = 100000._r8 - integer, parameter :: & - sclr_dim = 0 ! Higher-order scalars, set to zero - real(r8), parameter :: & wp3_const = 1._r8 ! Constant to add to wp3 when moments are advected @@ -177,6 +208,9 @@ module clubb_intr real(r8) :: clubb_detliq_rad = unset_r8 real(r8) :: clubb_detice_rad = unset_r8 real(r8) :: clubb_detphase_lowtemp = unset_r8 + real(r8) :: clubb_bv_efold = unset_r8 + real(r8) :: clubb_wpxp_Ri_exp = unset_r8 + real(r8) :: clubb_z_displace = unset_r8 integer :: & clubb_iiPDF_type, & ! Selected option for the two-component normal @@ -186,8 +220,8 @@ module clubb_intr clubb_ipdf_call_placement = unset_i, & ! Selected option for the placement of the call to ! CLUBB's PDF. clubb_penta_solve_method = unset_i, & ! Specifier for method to solve the penta-diagonal system - clubb_tridiag_solve_method = unset_i ! Specifier for method to solve tri-diagonal systems - + clubb_tridiag_solve_method = unset_i,& ! Specifier for method to solve tri-diagonal systems + clubb_saturation_equation = unset_i ! Specifier for which saturation formula to use logical :: & @@ -290,7 +324,9 @@ module clubb_intr ! Looking at issue #905 on the clubb repo clubb_l_use_tke_in_wp3_pr_turb_term,& ! Use TKE formulation for wp3 pr_turb term clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! Use TKE in eddy diffusion for wp2 and wp3 + clubb_l_use_wp3_lim_with_smth_Heaviside, & ! Flag to activate mods on wp3 limiters for conv test clubb_l_smooth_Heaviside_tau_wpxp, & ! Use smooth Heaviside 'Peskin' in computation of invrs_tau + clubb_l_modify_limiters_for_cnvg_test, & ! Flag to activate mods on limiters for conv test clubb_l_enable_relaxed_clipping, & ! Flag to relax clipping on wpxp in xm_wpxp_clipping_and_stats clubb_l_linearize_pbl_winds, & ! Flag to turn on code to linearize PBL winds clubb_l_single_C2_Skw, & ! Use a single Skewness dependent C2 for rtp2, thlp2, and @@ -304,13 +340,15 @@ module clubb_intr clubb_l_mono_flux_lim_vm, & ! Flag to turn on monotonic flux limiter for vm clubb_l_mono_flux_lim_spikefix, & ! Flag to implement monotonic flux limiter code that ! eliminates spurious drying tendencies at model top - clubb_l_intr_sfc_flux_smooth = .false.! Add a locally calculated roughness to upwp and vpwp sfc fluxes + clubb_l_host_applies_sfc_fluxes ! Whether the host model applies the surface fluxes + + logical :: & + clubb_l_intr_sfc_flux_smooth = .false. ! Add a locally calculated roughness to upwp and vpwp sfc fluxes ! Constant parameters logical, parameter, private :: & - l_implemented = .true., & ! Implemented in a host model (always true) - l_host_applies_sfc_fluxes = .false. ! Whether the host model applies the surface fluxes - + l_implemented = .true. ! Implemented in a host model (always true) + logical, parameter, private :: & apply_to_heat = .false. ! Apply WACCM energy fixer to heat or not (.true. = yes (duh)) @@ -392,6 +430,19 @@ module clubb_intr ztodt_idx,& ! physics timestep for SILHS clubbtop_idx ! level index for CLUBB top + ! For Gravity Wave code + integer :: & + ttend_clubb_idx, & + ttend_clubb_mc_idx, & + upwp_clubb_gw_idx, & + upwp_clubb_gw_mc_idx, & + vpwp_clubb_gw_idx, & + vpwp_clubb_gw_mc_idx, & + thlp2_clubb_gw_idx, & + thlp2_clubb_gw_mc_idx, & + wpthlp_clubb_gw_idx, & + wpthlp_clubb_gw_mc_idx + ! Indices for microphysical covariance tendencies integer :: & rtp2_mc_zt_idx, & @@ -466,7 +517,7 @@ subroutine clubb_register_cam( ) ! Register physics buffer fields and constituents ! !------------------------------------------------ ! - ! Add CLUBB fields to pbuf + ! Add CLUBB fields to pbuf use physics_buffer, only: pbuf_add_field, dtype_r8, dtype_i4, dyn_time_lvls use subcol_utils, only: subcol_get_scheme @@ -476,13 +527,8 @@ subroutine clubb_register_cam( ) history_budget_out = history_budget, & history_budget_histfile_num_out = history_budget_histfile_num, & do_hb_above_clubb_out = do_hb_above_clubb) - subcol_scheme = subcol_get_scheme() - if (trim(subcol_scheme) == 'SILHS') then - saturation_equation = "flatau" - else - saturation_equation = "gfdl" ! Goff & Gratch (1946) approximation for SVP - end if + subcol_scheme = subcol_get_scheme() if (clubb_do_adv) then cnst_names =(/'THLP2 ','RTP2 ','RTPTHLP','WPTHLP ','WPRTP ','WP2 ','WP3 ','UP2 ','VP2 '/) @@ -563,6 +609,19 @@ subroutine clubb_register_cam( ) call pbuf_add_field('WP2UP2', 'global', dtype_r8, (/pcols,pverp/), wp2up2_idx) call pbuf_add_field('WP2VP2', 'global', dtype_r8, (/pcols,pverp/), wp2vp2_idx) + ! pbuf fields for Gravity Wave scheme + call pbuf_add_field('TTEND_CLUBB', 'physpkg', dtype_r8, (/pcols,pver/), ttend_clubb_idx) + call pbuf_add_field('UPWP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), upwp_clubb_gw_idx) + call pbuf_add_field('VPWP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), vpwp_clubb_gw_idx) + call pbuf_add_field('THLP2_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), thlp2_clubb_gw_idx) + call pbuf_add_field('WPTHLP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), wpthlp_clubb_gw_idx) + + call pbuf_add_field('TTEND_CLUBB_MC', 'physpkg', dtype_r8, (/pcols,pverp/), ttend_clubb_mc_idx) + call pbuf_add_field('UPWP_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,pverp/), upwp_clubb_gw_mc_idx) + call pbuf_add_field('VPWP_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,pverp/), vpwp_clubb_gw_mc_idx) + call pbuf_add_field('THLP2_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,pverp/), thlp2_clubb_gw_mc_idx) + call pbuf_add_field('WPTHLP_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,pverp/), wpthlp_clubb_gw_mc_idx) + ! For SILHS microphysical covariance contributions call pbuf_add_field('rtp2_mc_zt', 'global', dtype_r8, (/pcols,pverp/), rtp2_mc_zt_idx) call pbuf_add_field('thlp2_mc_zt','global', dtype_r8, (/pcols,pverp/), thlp2_mc_zt_idx) @@ -697,8 +756,7 @@ subroutine clubb_readnl(nlfile) use clubb_api_module, only: & set_default_clubb_config_flags_api, & ! Procedure(s) - initialize_clubb_config_flags_type_api, & - l_stats, l_output_rad_files + initialize_clubb_config_flags_type_api #endif character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -717,6 +775,7 @@ subroutine clubb_readnl(nlfile) clubb_do_adv, clubb_timestep, & clubb_rnevap_effic,clubb_do_icesuper namelist /clubb_params_nl/ clubb_beta, & + clubb_bv_efold, & clubb_c1, & clubb_c1b, & clubb_c11, & @@ -761,17 +820,25 @@ subroutine clubb_readnl(nlfile) clubb_do_liqsupersat, & clubb_gamma_coef, & clubb_gamma_coefb, & + clubb_iiPDF_type, & clubb_ipdf_call_placement, & clubb_lambda0_stability_coef, & clubb_lmin_coef, & clubb_l_brunt_vaisala_freq_moist, & + clubb_l_C2_cloud_frac, & + clubb_l_calc_thlp2_rad, & + clubb_l_calc_w_corr, & clubb_l_call_pdf_closure_twice, & + clubb_l_const_Nc_in_cloud, & clubb_l_damp_wp2_using_em, & clubb_l_damp_wp3_Skw_squared, & clubb_l_diag_Lscale_from_tau, & + clubb_l_diagnose_correlations, & + clubb_l_diffuse_rtm_and_thlm, & clubb_l_do_expldiff_rtm_thlm, & clubb_l_e3sm_config, & clubb_l_enable_relaxed_clipping, & + clubb_l_fix_w_chi_eta_correlations, & clubb_l_godunov_upwind_wpxp_ta, & clubb_l_godunov_upwind_xpyp_ta, & clubb_l_intr_sfc_flux_smooth, & @@ -779,6 +846,7 @@ subroutine clubb_readnl(nlfile) clubb_l_lscale_plume_centered, & clubb_l_min_wp2_from_corr_wx, & clubb_l_min_xp2_from_corr_wx, & + clubb_l_modify_limiters_for_cnvg_test, & clubb_l_mono_flux_lim_rtm, & clubb_l_mono_flux_lim_spikefix, & clubb_l_mono_flux_lim_thlm, & @@ -786,20 +854,28 @@ subroutine clubb_readnl(nlfile) clubb_l_mono_flux_lim_vm, & clubb_l_partial_upwind_wp3, & clubb_l_predict_upwp_vpwp, & + clubb_l_prescribed_avg_deltaz, & clubb_l_rcm_supersat_adj, & + clubb_l_rtm_nudge, & clubb_l_smooth_Heaviside_tau_wpxp, & + clubb_l_stability_correct_Kh_N2_zm, & clubb_l_stability_correct_tau_zm, & clubb_l_standard_term_ta, & + clubb_l_tke_aniso, & clubb_l_trapezoidal_rule_zm, & clubb_l_trapezoidal_rule_zt, & + clubb_l_upwind_xm_ma, & clubb_l_upwind_xpyp_ta, & clubb_l_use_C11_Richardson, & clubb_l_use_C7_Richardson, & clubb_l_use_cloud_cover, & + clubb_l_use_precip_frac, & clubb_l_use_shear_Richardson, & clubb_l_use_thvm_in_bv_freq, & clubb_l_use_tke_in_wp2_wp3_K_dfsn, & clubb_l_use_tke_in_wp3_pr_turb_term, & + clubb_l_use_wp3_lim_with_smth_Heaviside, & + clubb_l_uv_nudge, & clubb_l_vary_convect_depth, & clubb_l_vert_avg_closure, & clubb_mult_coef, & @@ -810,22 +886,25 @@ subroutine clubb_readnl(nlfile) clubb_skw_max_mag, & clubb_tridiag_solve_method, & clubb_up2_sfc_coef, & - clubb_wpxp_L_thresh + clubb_wpxp_L_thresh, & + clubb_wpxp_Ri_exp, & + clubb_z_displace !----- Begin Code ----- ! Determine if we want clubb_history to be output - clubb_history = .false. ! Initialize to false - l_stats = .false. ! Initialize to false - l_output_rad_files = .false. ! Initialize to false - do_cldcool = .false. ! Initialize to false - do_rainturb = .false. ! Initialize to false + clubb_history = .false. ! Initialize to false + stats_metadata%l_stats = .false. ! Initialize to false + stats_metadata%l_output_rad_files = .false. ! Initialize to false + do_cldcool = .false. ! Initialize to false + do_rainturb = .false. ! Initialize to false ! Initialize namelist variables to clubb defaults call set_default_clubb_config_flags_api( clubb_iiPDF_type, & ! Out clubb_ipdf_call_placement, & ! Out clubb_penta_solve_method, & ! Out clubb_tridiag_solve_method, & ! Out + clubb_saturation_equation, & ! Out clubb_l_use_precip_frac, & ! Out clubb_l_predict_upwp_vpwp, & ! Out clubb_l_min_wp2_from_corr_wx, & ! Out @@ -870,14 +949,17 @@ subroutine clubb_readnl(nlfile) clubb_l_vary_convect_depth, & ! Out clubb_l_use_tke_in_wp3_pr_turb_term, & ! Out clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! Out + clubb_l_use_wp3_lim_with_smth_Heaviside, & ! Out clubb_l_smooth_Heaviside_tau_wpxp, & ! Out + clubb_l_modify_limiters_for_cnvg_test, & ! Out clubb_l_enable_relaxed_clipping, & ! Out clubb_l_linearize_pbl_winds, & ! Out clubb_l_mono_flux_lim_thlm, & ! Out clubb_l_mono_flux_lim_rtm, & ! Out clubb_l_mono_flux_lim_um, & ! Out clubb_l_mono_flux_lim_vm, & ! Out - clubb_l_mono_flux_lim_spikefix ) ! Out + clubb_l_mono_flux_lim_spikefix, & ! Out + clubb_l_host_applies_sfc_fluxes ) ! Out ! Call CLUBB+MF namelist call clubb_mf_readnl(nlfile) @@ -1007,6 +1089,12 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_nu9") call mpi_bcast(clubb_C_wp2_splat, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_wp2_splat") + call mpi_bcast(clubb_bv_efold, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_bv_efold") + call mpi_bcast(clubb_wpxp_Ri_exp, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_wpxp_Ri_exp") + call mpi_bcast(clubb_z_displace, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_z_displace") call mpi_bcast(clubb_lambda0_stability_coef, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_lambda0_stability_coef") call mpi_bcast(clubb_l_lscale_plume_centered,1, mpi_logical, mstrid, mpicom, ierr) @@ -1047,6 +1135,8 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_detice_rad") call mpi_bcast(clubb_detphase_lowtemp, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_detphase_lowtemp") + call mpi_bcast(clubb_iiPDF_type, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_iiPDF_type") call mpi_bcast(clubb_l_use_C7_Richardson, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_C7_Richardson") @@ -1100,8 +1190,12 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_tke_in_wp3_pr_turb_term") call mpi_bcast(clubb_l_use_tke_in_wp2_wp3_K_dfsn, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_tke_in_wp2_wp3_K_dfsn") + call mpi_bcast(clubb_l_use_wp3_lim_with_smth_Heaviside, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_wp3_lim_with_smth_Heaviside") call mpi_bcast(clubb_l_smooth_Heaviside_tau_wpxp, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_smooth_Heaviside_tau_wpxp") + call mpi_bcast(clubb_l_modify_limiters_for_cnvg_test, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_modify_limiters_for_cnvg_test") call mpi_bcast(clubb_ipdf_call_placement, 1, mpi_integer, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_ipdf_call_placement") call mpi_bcast(clubb_l_mono_flux_lim_thlm, 1, mpi_logical, mstrid, mpicom, ierr) @@ -1114,10 +1208,14 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_mono_flux_lim_vm") call mpi_bcast(clubb_l_mono_flux_lim_spikefix, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_mono_flux_lim_spikefix") + call mpi_bcast(clubb_l_host_applies_sfc_fluxes, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_host_applies_sfc_fluxes") call mpi_bcast(clubb_penta_solve_method, 1, mpi_integer, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_penta_solve_method") call mpi_bcast(clubb_tridiag_solve_method, 1, mpi_integer, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_tridiag_solve_method") + call mpi_bcast(clubb_saturation_equation, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_saturation_equation") call mpi_bcast(clubb_l_intr_sfc_flux_smooth, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_intr_sfc_flux_smooth") call mpi_bcast(clubb_l_vary_convect_depth, 1, mpi_logical, mstrid, mpicom, ierr) @@ -1126,10 +1224,38 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_standard_term_ta") call mpi_bcast(clubb_l_partial_upwind_wp3, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_partial_upwind_wp3") + call mpi_bcast(clubb_l_C2_cloud_frac, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_C2_cloud_frac") + call mpi_bcast(clubb_l_calc_thlp2_rad, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_calc_thlp2_rad") + call mpi_bcast(clubb_l_calc_w_corr, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_calc_w_corr") + call mpi_bcast(clubb_l_const_Nc_in_cloud, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_const_Nc_in_cloud") + call mpi_bcast(clubb_l_diagnose_correlations, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_diagnose_correlations") + call mpi_bcast(clubb_l_diffuse_rtm_and_thlm, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_diffuse_rtm_and_thlm") + call mpi_bcast(clubb_l_fix_w_chi_eta_correlations, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_fix_w_chi_eta_correlations") + call mpi_bcast(clubb_l_prescribed_avg_deltaz, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_prescribed_avg_deltaz") + call mpi_bcast(clubb_l_rtm_nudge, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_rtm_nudge") + call mpi_bcast(clubb_l_stability_correct_Kh_N2_zm, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_stability_correct_Kh_N2_zm") + call mpi_bcast(clubb_l_tke_aniso, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_tke_aniso") + call mpi_bcast(clubb_l_upwind_xm_ma, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_upwind_xm_ma") + call mpi_bcast(clubb_l_use_precip_frac, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_precip_frac") + call mpi_bcast(clubb_l_uv_nudge, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_uv_nudge") ! Overwrite defaults if they are true - if (clubb_history) l_stats = .true. - if (clubb_rad_history) l_output_rad_files = .true. + if (clubb_history) stats_metadata%l_stats = .true. + if (clubb_rad_history) stats_metadata%l_output_rad_files = .true. if (clubb_cloudtop_cooling) do_cldcool = .true. if (clubb_rainevap_turb) do_rainturb = .true. @@ -1185,13 +1311,17 @@ subroutine clubb_readnl(nlfile) if(clubb_Skw_denom_coef == unset_r8) call endrun(sub//": FATAL: clubb_Skw_denom_coef is not set") if(clubb_skw_max_mag == unset_r8) call endrun(sub//": FATAL: clubb_skw_max_mag is not set") if(clubb_up2_sfc_coef == unset_r8) call endrun(sub//": FATAL: clubb_up2_sfc_coef is not set") - if(clubb_C_wp2_splat == unset_r8) call endrun(sub//": FATAL: clubb_C_wp2_splatis not set") + if(clubb_C_wp2_splat == unset_r8) call endrun(sub//": FATAL: clubb_C_wp2_splat is not set") + if(clubb_bv_efold == unset_r8) call endrun(sub//": FATAL: clubb_bv_efold is not set") + if(clubb_wpxp_Ri_exp == unset_r8) call endrun(sub//": FATAL: clubb_wpxp_Ri_exp is not set") + if(clubb_z_displace == unset_r8) call endrun(sub//": FATAL: clubb_z_displace is not set") if(clubb_detliq_rad == unset_r8) call endrun(sub//": FATAL: clubb_detliq_rad not set") if(clubb_detice_rad == unset_r8) call endrun(sub//": FATAL: clubb_detice_rad not set") if(clubb_ipdf_call_placement == unset_i) call endrun(sub//": FATAL: clubb_ipdf_call_placement not set") if(clubb_detphase_lowtemp == unset_r8) call endrun(sub//": FATAL: clubb_detphase_lowtemp not set") if(clubb_penta_solve_method == unset_i) call endrun(sub//": FATAL: clubb_penta_solve_method not set") if(clubb_tridiag_solve_method == unset_i) call endrun(sub//": FATAL: clubb_tridiag_solve_method not set") + if(clubb_saturation_equation == unset_i) call endrun(sub//": FATAL: clubb_saturation_equation not set") if(clubb_detphase_lowtemp >= meltpt_temp) & call endrun(sub//": ERROR: clubb_detphase_lowtemp must be less than 268.15 K") @@ -1199,6 +1329,7 @@ subroutine clubb_readnl(nlfile) clubb_ipdf_call_placement, & ! In clubb_penta_solve_method, & ! In clubb_tridiag_solve_method, & ! In + clubb_saturation_equation, & ! In clubb_l_use_precip_frac, & ! In clubb_l_predict_upwp_vpwp, & ! In clubb_l_min_wp2_from_corr_wx, & ! In @@ -1243,7 +1374,9 @@ subroutine clubb_readnl(nlfile) clubb_l_vary_convect_depth, & ! In clubb_l_use_tke_in_wp3_pr_turb_term, & ! In clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! In + clubb_l_use_wp3_lim_with_smth_Heaviside, & ! In clubb_l_smooth_Heaviside_tau_wpxp, & ! In + clubb_l_modify_limiters_for_cnvg_test, & ! In clubb_l_enable_relaxed_clipping, & ! In clubb_l_linearize_pbl_winds, & ! In clubb_l_mono_flux_lim_thlm, & ! In @@ -1251,6 +1384,7 @@ subroutine clubb_readnl(nlfile) clubb_l_mono_flux_lim_um, & ! In clubb_l_mono_flux_lim_vm, & ! In clubb_l_mono_flux_lim_spikefix, & ! In + clubb_l_host_applies_sfc_fluxes, & ! In clubb_config_flags ) ! Out #endif @@ -1289,12 +1423,15 @@ subroutine clubb_ini_cam(pbuf2d) iC14, iC_wp3_pr_turb, igamma_coef, igamma_coefb, imult_coef, ilmin_coef, & iSkw_denom_coef, ibeta, iskw_max_mag, & iC_invrs_tau_bkgnd,iC_invrs_tau_sfc,iC_invrs_tau_shear,iC_invrs_tau_N2,iC_invrs_tau_N2_wp2, & - iC_invrs_tau_N2_xp2,iC_invrs_tau_N2_wpxp,iC_invrs_tau_N2_clear_wp3,iC_uu_shr,iC_uu_buoy, & - iC2rt, iC2thl, iC2rtthl, ic_K1, ic_K2, inu2, ic_K8, ic_K9, inu9, iC_wp2_splat, params_list + iC_invrs_tau_N2_xp2,iC_invrs_tau_N2_wpxp,iC_invrs_tau_N2_clear_wp3, & + iC2rt, iC2thl, iC2rtthl, ic_K1, ic_K2, inu2, ic_K8, ic_K9, inu9, iC_wp2_splat, ibv_efold, & + iwpxp_Ri_exp, iz_displace, & + params_list use clubb_api_module, only: & print_clubb_config_flags_api, & - setup_clubb_core_api, & + setup_parameters_model_api, & + check_clubb_settings_api, & init_pdf_params_api, & time_precision, & core_rknd, & @@ -1303,24 +1440,15 @@ subroutine clubb_ini_cam(pbuf2d) nparams, & set_default_parameters_api, & read_parameters_api, & - l_stats, & - l_stats_samp, & - l_grads, & w_tol_sqd, & rt_tol, & - thl_tol - - ! These are only needed if we're using a passive scalar - use clubb_api_module, only: & - iisclr_rt, & - iisclr_thl, & - iisclr_CO2, & - iiedsclr_rt, & - iiedsclr_thl, & - iiedsclr_CO2 + thl_tol, & + saturation_bolton, & ! Constant for Bolton approximations of saturation + saturation_gfdl, & ! Constant for the GFDL approximation of saturation + saturation_flatau, & ! Constant for Flatau approximations of saturation + saturation_lookup ! Use a lookup table for mixing length use time_manager, only: is_first_step - use clubb_api_module, only: hydromet_dim use constituents, only: cnst_get_ind use phys_control, only: phys_getopts use spmd_utils, only: iam @@ -1348,7 +1476,7 @@ subroutine clubb_ini_cam(pbuf2d) logical, parameter :: l_input_fields = .false. ! Always false for CAM-CLUBB. logical, parameter :: l_update_pressure = .false. ! Always false for CAM-CLUBB. - integer :: nlev + integer :: nlev, ierr=0 real(r8) :: & C1, C1b, C1c, C2rt, C2thl, C2rtthl, & @@ -1371,7 +1499,8 @@ subroutine clubb_ini_cam(pbuf2d) C_invrs_tau_shear, C_invrs_tau_N2, C_invrs_tau_N2_wp2, & C_invrs_tau_N2_xp2, C_invrs_tau_N2_wpxp, C_invrs_tau_N2_clear_wp3, & C_invrs_tau_wpxp_Ri, C_invrs_tau_wpxp_N2_thresh, & - Cx_min, Cx_max, Richardson_num_min, Richardson_num_max, a3_coef_min + Cx_min, Cx_max, Richardson_num_min, Richardson_num_max, wpxp_Ri_exp, & + a3_coef_min, a_const, bv_efold, z_displace !----- Begin Code ----- @@ -1385,7 +1514,8 @@ subroutine clubb_ini_cam(pbuf2d) allocate( & pdf_params_chnk(begchunk:endchunk), & pdf_params_zm_chnk(begchunk:endchunk), & - pdf_implicit_coefs_terms_chnk(begchunk:endchunk) ) + pdf_implicit_coefs_terms_chnk(begchunk:endchunk), stat=ierr ) + if( ierr /= 0 ) call endrun(' clubb_ini_cam: failed to allocate pdf_params') ! ----------------------------------------------------------------- ! ! Determine how many constituents CLUBB will transport. Note that @@ -1448,11 +1578,11 @@ subroutine clubb_ini_cam(pbuf2d) ! Defaults - l_stats_samp = .false. - l_grads = .false. + stats_metadata%l_stats_samp = .false. + stats_metadata%l_grads = .false. - ! Overwrite defaults if needbe - if (l_stats) l_stats_samp = .true. + ! Overwrite defaults if needed + if (stats_metadata%l_stats) stats_metadata%l_stats_samp = .true. ! Define physics buffers indexes cld_idx = pbuf_get_index('CLD') ! Cloud fraction @@ -1474,13 +1604,13 @@ subroutine clubb_ini_cam(pbuf2d) npccn_idx = pbuf_get_index('NPCCN') - iisclr_rt = -1 - iisclr_thl = -1 - iisclr_CO2 = -1 + sclr_idx%iisclr_rt = -1 + sclr_idx%iisclr_thl = -1 + sclr_idx%iisclr_CO2 = -1 - iiedsclr_rt = -1 - iiedsclr_thl = -1 - iiedsclr_CO2 = -1 + sclr_idx%iiedsclr_rt = -1 + sclr_idx%iiedsclr_thl = -1 + sclr_idx%iiedsclr_CO2 = -1 ! ----------------------------------------------------------------- ! ! Define number of tracers for CLUBB to diffuse @@ -1519,10 +1649,10 @@ subroutine clubb_ini_cam(pbuf2d) C_invrs_tau_N2_wp2, C_invrs_tau_N2_xp2, & C_invrs_tau_N2_wpxp, C_invrs_tau_N2_clear_wp3, & C_invrs_tau_wpxp_Ri, C_invrs_tau_wpxp_N2_thresh, & - Cx_min, Cx_max, Richardson_num_min, & - Richardson_num_max, a3_coef_min ) + Cx_min, Cx_max, Richardson_num_min, Richardson_num_max, & + wpxp_Ri_exp, a3_coef_min, a_const, bv_efold, z_displace ) - call read_parameters_api( -99, "", & + call read_parameters_api( 1, -99, "", & C1, C1b, C1c, C2rt, C2thl, C2rtthl, & C4, C_uu_shr, C_uu_buoy, C6rt, C6rtb, C6rtc, & C6thl, C6thlb, C6thlc, C7, C7b, C7c, C8, C8b, C10, & @@ -1545,82 +1675,83 @@ subroutine clubb_ini_cam(pbuf2d) C_invrs_tau_N2_wp2, C_invrs_tau_N2_xp2, & C_invrs_tau_N2_wpxp, C_invrs_tau_N2_clear_wp3, & C_invrs_tau_wpxp_Ri, C_invrs_tau_wpxp_N2_thresh, & - Cx_min, Cx_max, Richardson_num_min, & - Richardson_num_max, a3_coef_min, & - clubb_params ) - - clubb_params(iC2rtthl) = clubb_C2rtthl - clubb_params(iC8) = clubb_C8 - clubb_params(iC11) = clubb_c11 - clubb_params(iC11b) = clubb_c11b - clubb_params(iC14) = clubb_c14 - clubb_params(iC_wp3_pr_turb) = clubb_C_wp3_pr_turb - clubb_params(ic_K10) = clubb_c_K10 - clubb_params(imult_coef) = clubb_mult_coef - clubb_params(iSkw_denom_coef) = clubb_Skw_denom_coef - clubb_params(iC2rt) = clubb_C2rt - clubb_params(iC2thl) = clubb_C2thl - clubb_params(ibeta) = clubb_beta - clubb_params(iC6rt) = clubb_c6rt - clubb_params(iC6rtb) = clubb_c6rtb - clubb_params(iC6rtc) = clubb_c6rtc - clubb_params(iC6thl) = clubb_c6thl - clubb_params(iC6thlb) = clubb_c6thlb - clubb_params(iC6thlc) = clubb_c6thlc - clubb_params(iwpxp_L_thresh) = clubb_wpxp_L_thresh - clubb_params(iC7) = clubb_C7 - clubb_params(iC7b) = clubb_C7b - clubb_params(igamma_coef) = clubb_gamma_coef - clubb_params(ic_K10h) = clubb_c_K10h - clubb_params(ilambda0_stability_coef) = clubb_lambda0_stability_coef - clubb_params(ilmin_coef) = clubb_lmin_coef - clubb_params(iC8b) = clubb_C8b - clubb_params(iskw_max_mag) = clubb_skw_max_mag - clubb_params(iC1) = clubb_C1 - clubb_params(iC1b) = clubb_C1b - clubb_params(igamma_coefb) = clubb_gamma_coefb - clubb_params(iup2_sfc_coef) = clubb_up2_sfc_coef - clubb_params(iC4) = clubb_C4 - clubb_params(iC_uu_shr) = clubb_C_uu_shr - clubb_params(iC_uu_buoy) = clubb_C_uu_buoy - clubb_params(ic_K1) = clubb_c_K1 - clubb_params(ic_K2) = clubb_c_K2 - clubb_params(inu2) = clubb_nu2 - clubb_params(ic_K8) = clubb_c_K8 - clubb_params(ic_K9) = clubb_c_K9 - clubb_params(inu9) = clubb_nu9 - clubb_params(iC_wp2_splat) = clubb_C_wp2_splat - clubb_params(iC_invrs_tau_bkgnd) = clubb_C_invrs_tau_bkgnd - clubb_params(iC_invrs_tau_sfc) = clubb_C_invrs_tau_sfc - clubb_params(iC_invrs_tau_shear) = clubb_C_invrs_tau_shear - clubb_params(iC_invrs_tau_N2) = clubb_C_invrs_tau_N2 - clubb_params(iC_invrs_tau_N2_wp2) = clubb_C_invrs_tau_N2_wp2 - clubb_params(iC_invrs_tau_N2_xp2) = clubb_C_invrs_tau_N2_xp2 - clubb_params(iC_invrs_tau_N2_wpxp) = clubb_C_invrs_tau_N2_wpxp - clubb_params(iC_invrs_tau_N2_clear_wp3) = clubb_C_invrs_tau_N2_clear_wp3 + Cx_min, Cx_max, Richardson_num_min, Richardson_num_max, & + wpxp_Ri_exp, a3_coef_min, a_const, bv_efold, z_displace, & + clubb_params_single_col ) + + clubb_params_single_col(iC2rtthl) = clubb_C2rtthl + clubb_params_single_col(iC8) = clubb_C8 + clubb_params_single_col(iC11) = clubb_c11 + clubb_params_single_col(iC11b) = clubb_c11b + clubb_params_single_col(iC14) = clubb_c14 + clubb_params_single_col(iC_wp3_pr_turb) = clubb_C_wp3_pr_turb + clubb_params_single_col(ic_K10) = clubb_c_K10 + clubb_params_single_col(imult_coef) = clubb_mult_coef + clubb_params_single_col(iSkw_denom_coef) = clubb_Skw_denom_coef + clubb_params_single_col(iC2rt) = clubb_C2rt + clubb_params_single_col(iC2thl) = clubb_C2thl + clubb_params_single_col(ibeta) = clubb_beta + clubb_params_single_col(iC6rt) = clubb_c6rt + clubb_params_single_col(iC6rtb) = clubb_c6rtb + clubb_params_single_col(iC6rtc) = clubb_c6rtc + clubb_params_single_col(iC6thl) = clubb_c6thl + clubb_params_single_col(iC6thlb) = clubb_c6thlb + clubb_params_single_col(iC6thlc) = clubb_c6thlc + clubb_params_single_col(iwpxp_L_thresh) = clubb_wpxp_L_thresh + clubb_params_single_col(iC7) = clubb_C7 + clubb_params_single_col(iC7b) = clubb_C7b + clubb_params_single_col(igamma_coef) = clubb_gamma_coef + clubb_params_single_col(ic_K10h) = clubb_c_K10h + clubb_params_single_col(ilambda0_stability_coef) = clubb_lambda0_stability_coef + clubb_params_single_col(ilmin_coef) = clubb_lmin_coef + clubb_params_single_col(iC8b) = clubb_C8b + clubb_params_single_col(iskw_max_mag) = clubb_skw_max_mag + clubb_params_single_col(iC1) = clubb_C1 + clubb_params_single_col(iC1b) = clubb_C1b + clubb_params_single_col(igamma_coefb) = clubb_gamma_coefb + clubb_params_single_col(iup2_sfc_coef) = clubb_up2_sfc_coef + clubb_params_single_col(iC4) = clubb_C4 + clubb_params_single_col(iC_uu_shr) = clubb_C_uu_shr + clubb_params_single_col(iC_uu_buoy) = clubb_C_uu_buoy + clubb_params_single_col(ic_K1) = clubb_c_K1 + clubb_params_single_col(ic_K2) = clubb_c_K2 + clubb_params_single_col(inu2) = clubb_nu2 + clubb_params_single_col(ic_K8) = clubb_c_K8 + clubb_params_single_col(ic_K9) = clubb_c_K9 + clubb_params_single_col(inu9) = clubb_nu9 + clubb_params_single_col(iC_wp2_splat) = clubb_C_wp2_splat + clubb_params_single_col(iC_invrs_tau_bkgnd) = clubb_C_invrs_tau_bkgnd + clubb_params_single_col(iC_invrs_tau_sfc) = clubb_C_invrs_tau_sfc + clubb_params_single_col(iC_invrs_tau_shear) = clubb_C_invrs_tau_shear + clubb_params_single_col(iC_invrs_tau_N2) = clubb_C_invrs_tau_N2 + clubb_params_single_col(iC_invrs_tau_N2_wp2) = clubb_C_invrs_tau_N2_wp2 + clubb_params_single_col(iC_invrs_tau_N2_xp2) = clubb_C_invrs_tau_N2_xp2 + clubb_params_single_col(iC_invrs_tau_N2_wpxp) = clubb_C_invrs_tau_N2_wpxp + clubb_params_single_col(iC_invrs_tau_N2_clear_wp3) = clubb_C_invrs_tau_N2_clear_wp3 + clubb_params_single_col(ibv_efold) = clubb_bv_efold + clubb_params_single_col(iwpxp_Ri_exp) = clubb_wpxp_Ri_exp + clubb_params_single_col(iz_displace) = clubb_z_displace + + ! Override clubb default + if ( trim(subcol_scheme) == 'SILHS' ) then + clubb_config_flags%saturation_formula = saturation_flatau + else + clubb_config_flags%saturation_formula = saturation_gfdl ! Goff & Gratch (1946) approximation for SVP + end if + ! Define model constant parameters + call setup_parameters_model_api( theta0, ts_nudge, clubb_params_single_col(iSkw_max_mag) ) + ! Set up CLUBB core. Note that some of these inputs are overwritten ! when clubb_tend_cam is called. The reason is that heights can change ! at each time step, which is why dummy arrays are read in here for heights ! as they are immediately overwrote. !$OMP PARALLEL - call setup_clubb_core_api & - ( nlev+1, theta0, ts_nudge, & ! In - hydromet_dim, sclr_dim, & ! In - sclr_tol, edsclr_dim, clubb_params, & ! In - l_host_applies_sfc_fluxes, & ! In - saturation_equation, & ! In - l_input_fields, & ! In - clubb_config_flags%iiPDF_type, & ! In - clubb_config_flags%ipdf_call_placement, & ! In - clubb_config_flags%l_predict_upwp_vpwp, & ! In - clubb_config_flags%l_min_xp2_from_corr_wx, & ! In - clubb_config_flags%l_prescribed_avg_deltaz, & ! In - clubb_config_flags%l_damp_wp2_using_em, & ! In - clubb_config_flags%l_stability_correct_tau_zm, & ! In - clubb_config_flags%l_enable_relaxed_clipping, & ! In - clubb_config_flags%l_diag_Lscale_from_tau, & ! In - err_code ) ! Out + call check_clubb_settings_api( nlev+1, clubb_params_single_col, & ! Intent(in) + l_implemented, & ! Intent(in) + l_input_fields, & ! Intent(in) + clubb_config_flags, & ! intent(in) + err_code ) ! Intent(out) if ( err_code == clubb_fatal_error ) then call endrun('clubb_ini_cam: FATAL ERROR CALLING SETUP_CLUBB_CORE') @@ -1630,7 +1761,7 @@ subroutine clubb_ini_cam(pbuf2d) ! Print the list of CLUBB parameters if ( masterproc ) then do j = 1, nparams, 1 - write(iulog,*) params_list(j), " = ", clubb_params(j) + write(iulog,*) params_list(j), " = ", clubb_params_single_col(j) enddo endif @@ -1737,26 +1868,41 @@ subroutine clubb_ini_cam(pbuf2d) call addfld ( 'edmf_qtflx' , (/ 'ilev' /), 'A', 'W/m2' , 'qt flux (EDMF)' ) end if + if ( trim(subcol_scheme) /= 'SILHS' ) then + ! hm_metadata is set up by calling init_pdf_hydromet_arrays_api in subcol_init_SILHS. + ! So if we are not using silhs, we allocate the parts of hm_metadata that need allocating + ! in order to making intel debug tests happy. + allocate( hm_metadata%hydromet_list(1), stat=ierr) + if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate hm_metadata%hydromet_list' ) + allocate( hm_metadata%l_mix_rat_hm(1), stat=ierr) + if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate hm_metadata%l_mix_rat_hm' ) + end if + ! Initialize statistics, below are dummy variables dum1 = 300._r8 dum2 = 1200._r8 dum3 = 300._r8 - if (l_stats) then - - do i=1, pcols - call stats_init_clubb( .true., dum1, dum2, & - nlev+1, nlev+1, nlev+1, dum3, & - stats_zt(i), stats_zm(i), stats_sfc(i), & - stats_rad_zt(i), stats_rad_zm(i)) - end do - - allocate(out_zt(pcols,pverp,stats_zt(1)%num_output_fields)) - allocate(out_zm(pcols,pverp,stats_zm(1)%num_output_fields)) - allocate(out_sfc(pcols,1,stats_sfc(1)%num_output_fields)) - - allocate(out_radzt(pcols,pverp,stats_rad_zt(1)%num_output_fields)) - allocate(out_radzm(pcols,pverp,stats_rad_zm(1)%num_output_fields)) + if (stats_metadata%l_stats) then + + call stats_init_clubb( .true., dum1, dum2, & + nlev+1, nlev+1, nlev+1, dum3, & + stats_zt(:), stats_zm(:), stats_sfc(:), & + stats_rad_zt(:), stats_rad_zm(:)) + + allocate(out_zt(pcols,pverp,stats_zt(1)%num_output_fields), stat=ierr) + if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_zt' ) + allocate(out_zm(pcols,pverp,stats_zm(1)%num_output_fields), stat=ierr) + if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_zm' ) + allocate(out_sfc(pcols,1,stats_sfc(1)%num_output_fields), stat=ierr) + if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_sfc' ) + + if ( stats_metadata%l_output_rad_files ) then + allocate(out_radzt(pcols,pverp,stats_rad_zt(1)%num_output_fields), stat=ierr) + if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_radzt' ) + allocate(out_radzm(pcols,pverp,stats_rad_zm(1)%num_output_fields), stat=ierr) + if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_radzm' ) + end if endif @@ -1905,6 +2051,19 @@ subroutine clubb_ini_cam(pbuf2d) call pbuf_set_field(pbuf2d, pdf_zm_varnce_w_2_idx, 0.0_r8) call pbuf_set_field(pbuf2d, pdf_zm_mixt_frac_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, ttend_clubb_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, upwp_clubb_gw_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, vpwp_clubb_gw_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, thlp2_clubb_gw_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wpthlp_clubb_gw_idx, 0.0_r8) + + call pbuf_set_field(pbuf2d, ttend_clubb_mc_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, upwp_clubb_gw_mc_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, vpwp_clubb_gw_mc_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, thlp2_clubb_gw_mc_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wpthlp_clubb_gw_mc_idx, 0.0_r8) + + endif ! The following is physpkg, so it needs to be initialized every time @@ -1951,6 +2110,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & use cam_logfile, only: iulog use tropopause, only: tropopause_findChemTrop use time_manager, only: get_nstep, is_first_restart_step + #ifdef CLUBB_SGS use hb_diff, only: pblintd use scamMOD, only: single_column,scm_clubb_iop_name @@ -1965,12 +2125,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & w_tol_sqd, & rt_tol, & thl_tol, & - l_stats, & - stats_tsamp, & - stats_tout, & - l_output_rad_files, & stats_begin_timestep_api, & - hydromet_dim, calculate_thlp2_rad_api, update_xp2_mc_api, & + calculate_thlp2_rad_api, update_xp2_mc_api, & sat_mixrat_liq_api, & fstderr, & ipdf_post_advance_fields, & @@ -2059,6 +2215,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8) :: zo(pcols) ! roughness height [m] real(r8) :: dz_g(pcols,pver) ! thickness of layer [m] real(r8) :: relvarmax + real(r8) :: se_upper_a(pcols), se_upper_b(pcols), se_upper_diss(pcols) + real(r8) :: tw_upper_a(pcols), tw_upper_b(pcols), tw_upper_diss(pcols) ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES @@ -2177,7 +2335,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wp2up2_inout, & ! w'^2 u'^2 (momentum levels) wp2vp2_inout, & ! w'^2 v'^2 (momentum levels) zt_g, & ! Thermodynamic grid of CLUBB [m] - zi_g ! Momentum grid of CLUBB [m] + zi_g ! Momentum grid of CLUBB [m] ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES @@ -2259,6 +2417,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(kind=time_precision) :: time_elapsed ! time keep track of stats [s] integer :: stats_nsamp, stats_nout ! Stats sampling and output intervals for CLUBB [timestep] + real(r8) :: rtm_integral_vtend(pcols), & + rtm_integral_ltend(pcols) + + real(r8) :: rtm_integral_1, rtm_integral_update, rtm_integral_forcing ! ---------------------------------------------------- ! @@ -2339,6 +2501,20 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:,:) :: wpthlp_mc_zt real(r8), pointer, dimension(:,:) :: rtpthlp_mc_zt + ! Connections to Gravity Wave parameterization + real(r8), pointer, dimension(:,:) :: ttend_clubb + real(r8), pointer, dimension(:,:) :: upwp_clubb_gw + real(r8), pointer, dimension(:,:) :: vpwp_clubb_gw + real(r8), pointer, dimension(:,:) :: thlp2_clubb_gw + real(r8), pointer, dimension(:,:) :: wpthlp_clubb_gw + + real(r8), pointer, dimension(:,:) :: ttend_clubb_mc + real(r8), pointer, dimension(:,:) :: upwp_clubb_gw_mc + real(r8), pointer, dimension(:,:) :: vpwp_clubb_gw_mc + real(r8), pointer, dimension(:,:) :: thlp2_clubb_gw_mc + real(r8), pointer, dimension(:,:) :: wpthlp_clubb_gw_mc + + real(r8) qitend(pcols,pver) real(r8) initend(pcols,pver) ! Needed for ice supersaturation adjustment calculation @@ -2405,13 +2581,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & intrinsic :: max character(len=*), parameter :: subr='clubb_tend_cam' + real(r8), parameter :: rad2deg=180.0_r8/pi + real(r8) :: tmp_lon1, tmp_lonN type(grid) :: gr - integer :: begin_height, end_height type(nu_vertical_res_dep) :: nu_vert_res_dep ! Vertical resolution dependent nu values real(r8) :: lmin + real(r8), dimension(state%ncol,nparams) :: & + clubb_params ! Adjustable CLUBB parameters (C1, C2 ...) + #endif det_s(:) = 0.0_r8 det_ice(:) = 0.0_r8 @@ -2419,7 +2599,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & #ifdef CLUBB_SGS !-----------------------------------------------------------------------------------! - ! MAIN COMPUTATION BEGINS HERE ! ! + ! MAIN COMPUTATION BEGINS HERE ! !-----------------------------------------------------------------------------------! call t_startf("clubb_tend_cam") @@ -2466,8 +2646,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Copy the state to state1 array to use in this routine call physics_state_copy(state, state1) - ! constituents are all treated as dry mmr by clubb - call set_wet_to_dry(state1) + ! Constituents are all treated as dry mmr by clubb. Convert the water species to + ! a dry basis. + call set_wet_to_dry(state1, convert_cnst_type='wet') if (clubb_do_liqsupersat) then call pbuf_get_field(pbuf, npccn_idx, npccn) @@ -2560,6 +2741,20 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, wpthlp_mc_zt_idx, wpthlp_mc_zt) call pbuf_get_field(pbuf, rtpthlp_mc_zt_idx, rtpthlp_mc_zt) + ! For Gravity Wave + call pbuf_get_field(pbuf, ttend_clubb_idx, ttend_clubb ) + call pbuf_get_field(pbuf, thlp2_clubb_gw_idx, thlp2_clubb_gw ) + call pbuf_get_field(pbuf, upwp_clubb_gw_idx, upwp_clubb_gw ) + call pbuf_get_field(pbuf, vpwp_clubb_gw_idx, vpwp_clubb_gw ) + call pbuf_get_field(pbuf, wpthlp_clubb_gw_idx, wpthlp_clubb_gw ) + + call pbuf_get_field(pbuf, ttend_clubb_mc_idx, ttend_clubb_mc ) + call pbuf_get_field(pbuf, thlp2_clubb_gw_mc_idx, thlp2_clubb_gw_mc ) + call pbuf_get_field(pbuf, upwp_clubb_gw_mc_idx, upwp_clubb_gw_mc ) + call pbuf_get_field(pbuf, vpwp_clubb_gw_mc_idx, vpwp_clubb_gw_mc ) + call pbuf_get_field(pbuf, wpthlp_clubb_gw_mc_idx, wpthlp_clubb_gw_mc ) + + ! Allocate pdf_params only if they aren't allocated already. if ( .not. allocated(pdf_params_chnk(lchnk)%mixt_frac) ) then call init_pdf_params_api( pverp+1-top_lev, ncol, pdf_params_chnk(lchnk) ) @@ -2945,11 +3140,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do ! Set stats output and increment equal to CLUBB and host dt - stats_tsamp = dtime - stats_tout = hdtime + stats_metadata%stats_tsamp = dtime + stats_metadata%stats_tout = hdtime - stats_nsamp = nint(stats_tsamp/dtime) - stats_nout = nint(stats_tout/dtime) + stats_nsamp = nint(stats_metadata%stats_tsamp/dtime) + stats_nout = nint(stats_metadata%stats_tout/dtime) ! Heights need to be set at each timestep. Therefore, recall ! setup_grid and setup_parameters for this. @@ -2961,12 +3156,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call setup_grid_api( nlev+1, ncol, sfc_elevation, l_implemented, & ! intent(in) grid_type, zi_g(:,2), zi_g(:,1), zi_g(:,nlev+1), & ! intent(in) zi_g, zt_g, & ! intent(in) - gr, begin_height, end_height ) ! intent(out) + gr ) ! intent(out) + + do i = 1, ncol + clubb_params(i,:) = clubb_params_single_col(:) + end do - call setup_parameters_api( zi_g(:,2), clubb_params, nlev+1, ncol, grid_type, & ! intent(in) - zi_g, zt_g, & ! intent(in) - clubb_config_flags%l_prescribed_avg_deltaz, & ! intent(in) - lmin, nu_vert_res_dep, err_code ) ! intent(out) + call setup_parameters_api( zi_g(:,2), clubb_params, gr, ncol, grid_type, & ! intent(in) + clubb_config_flags%l_prescribed_avg_deltaz, & ! intent(in) + lmin, nu_vert_res_dep, err_code ) ! intent(out) if ( err_code == clubb_fatal_error ) then call endrun(subr//': Fatal error in CLUBB setup_parameters') end if @@ -3249,12 +3447,19 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif + ! need to initialize macmic coupling to zero + if (macmic_it==1) ttend_clubb_mc(:ncol,:) = 0._r8 + if (macmic_it==1) upwp_clubb_gw_mc(:ncol,:) = 0._r8 + if (macmic_it==1) vpwp_clubb_gw_mc(:ncol,:) = 0._r8 + if (macmic_it==1) thlp2_clubb_gw_mc(:ncol,:) = 0._r8 + if (macmic_it==1) wpthlp_clubb_gw_mc(:ncol,:) = 0._r8 do t=1,nadv ! do needed number of "sub" timesteps for each CAM step - ! Increment the statistics then being stats timestep - if (l_stats) then - call stats_begin_timestep_api(t, stats_nsamp, stats_nout) + ! Increment the statistics then begin stats timestep + if (stats_metadata%l_stats) then + call stats_begin_timestep_api( t, stats_nsamp, stats_nout, & + stats_metadata ) endif !####################################################################### @@ -3282,18 +3487,18 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & um_in(i,:), vm_in(i,:), thlm_in(i,:), rtm_in(i,:), thv(i,:), & ! input thlm_zm_in(i,:), rtm_zm_in(i,:), & ! input wpthlp_sfc(i), wprtp_sfc(i), pblh(i), & ! input - mf_dry_a(i,:), mf_moist_a(i,:), & ! output - plume diagnostics - mf_dry_w(i,:), mf_moist_w(i,:), & ! output - plume diagnostics - mf_dry_qt(i,:), mf_moist_qt(i,:), & ! output - plume diagnostics - mf_dry_thl(i,:), mf_moist_thl(i,:), & ! output - plume diagnostics - mf_dry_u(i,:), mf_moist_u(i,:), & ! output - plume diagnostics - mf_dry_v(i,:), mf_moist_v(i,:), & ! output - plume diagnostics - mf_moist_qc(i,:), & ! output - plume diagnostics - s_ae(i,:), s_aw(i,:), & ! output - plume diagnostics - s_awthl(i,:), s_awqt(i,:), & ! output - plume diagnostics - s_awql(i,:), s_awqi(i,:), & ! output - plume diagnostics - s_awu(i,:), s_awv(i,:), & ! output - plume diagnostics - mf_thlflx(i,:), mf_qtflx(i,:) ) ! output - variables needed for solver + mf_dry_a(i,:), mf_moist_a(i,:), & ! output - plume diagnostics + mf_dry_w(i,:), mf_moist_w(i,:), & ! output - plume diagnostics + mf_dry_qt(i,:), mf_moist_qt(i,:), & ! output - plume diagnostics + mf_dry_thl(i,:), mf_moist_thl(i,:), & ! output - plume diagnostics + mf_dry_u(i,:), mf_moist_u(i,:), & ! output - plume diagnostics + mf_dry_v(i,:), mf_moist_v(i,:), & ! output - plume diagnostics + mf_moist_qc(i,:), & ! output - plume diagnostics + s_ae(i,:), s_aw(i,:), & ! output - plume diagnostics + s_awthl(i,:), s_awqt(i,:), & ! output - plume diagnostics + s_awql(i,:), s_awqi(i,:), & ! output - plume diagnostics + s_awu(i,:), s_awv(i,:), & ! output - plume diagnostics + mf_thlflx(i,:), mf_qtflx(i,:) ) ! output - variables needed for solver end do ! pass MF turbulent advection term as CLUBB explicit forcing term @@ -3316,7 +3521,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Advance CLUBB CORE one timestep in the future call advance_clubb_core_api( gr, pverp+1-top_lev, ncol, & - l_implemented, dtime, fcor, sfc_elevation, hydromet_dim, & + l_implemented, dtime, fcor, sfc_elevation, & + hydromet_dim, & + sclr_dim, sclr_tol, edsclr_dim, sclr_idx, & thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & sclrm_forcing, edsclrm_forcing, wprtp_forcing, & wpthlp_forcing, rtp2_forcing, thlp2_forcing, & @@ -3327,12 +3534,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rtm_ref, thlm_ref, um_ref, vm_ref, ug, vg, & p_in_Pa, rho_zm, rho_zt, exner, & rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & - invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, hydromet, & + invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, & + hydromet, hm_metadata%l_mix_rat_hm, & rfrzm, radf, & wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt, & grid_dx, grid_dy, & clubb_params, nu_vert_res_dep, lmin, & clubb_config_flags, & + stats_metadata, & stats_zt(:ncol), stats_zm(:ncol), stats_sfc(:ncol), & um_in, vm_in, upwp_in, vpwp_in, up2_in, vp2_in, up3_in, vp3_in, & thlm_in, rtm_in, wprtp_in, wpthlp_in, & @@ -3360,8 +3569,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! one value only for the entire chunk if ( err_code == clubb_fatal_error ) then write(fstderr,*) "Fatal error in CLUBB: at timestep ", get_nstep() - write(fstderr,*) "LAT Range: ", state1%lat(1), " -- ", state1%lat(ncol) - write(fstderr,*) "LON: Range:", state1%lon(1), " -- ", state1%lon(ncol) + write(fstderr,*) "LAT Range: ", state1%lat(1)*rad2deg, & + " -- ", state1%lat(ncol)*rad2deg + tmp_lon1 = state1%lon(1)*rad2deg + tmp_lon1 = state1%lon(ncol)*rad2deg + if(tmp_lon1.gt.180.0_r8) tmp_lon1=tmp_lon1-360.0_r8 + if(tmp_lonN.gt.180.0_r8) tmp_lonN=tmp_lonN-360.0_r8 + write(fstderr,*) "LON: Range:", tmp_lon1, " -- ", tmp_lonN call endrun(subr//': Fatal error in CLUBB library') end if @@ -3402,7 +3616,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & thlp2_rad_out(:,:) = 0._r8 do i=1, ncol - call calculate_thlp2_rad_api(nlev+1, rcm_out_zm(i,:), thlprcp_out(i,:), qrl_zm(i,:), clubb_params, & + call calculate_thlp2_rad_api(nlev+1, rcm_out_zm(i,:), thlprcp_out(i,:), qrl_zm(i,:), clubb_params(i,:), & thlp2_rad_out(i,:)) end do @@ -3415,7 +3629,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Check to see if stats should be output, here stats are read into ! output arrays to make them conformable to CAM output - if (l_stats) then + if (stats_metadata%l_stats) then do i=1, ncol call stats_end_timestep_clubb(i, stats_zt(i), stats_zm(i), stats_rad_zt(i), stats_rad_zm(i), stats_sfc(i), & out_zt, out_zm, out_radzt, out_radzm, out_sfc) @@ -3514,6 +3728,20 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do + ! Accumulate vars through macmic subcycle + upwp_clubb_gw_mc(:ncol,:) = upwp_clubb_gw_mc(:ncol,:) + upwp(:ncol,:) + vpwp_clubb_gw_mc(:ncol,:) = vpwp_clubb_gw_mc(:ncol,:) + vpwp(:ncol,:) + thlp2_clubb_gw_mc(:ncol,:) = thlp2_clubb_gw_mc(:ncol,:) + thlp2(:ncol,:) + wpthlp_clubb_gw_mc(:ncol,:) = wpthlp_clubb_gw_mc(:ncol,:) + wpthlp(:ncol,:) + + ! And average at last macmic step + if (macmic_it == cld_macmic_num_steps) then + upwp_clubb_gw(:ncol,:) = upwp_clubb_gw_mc(:ncol,:)/REAL(cld_macmic_num_steps,r8) + vpwp_clubb_gw(:ncol,:) = vpwp_clubb_gw_mc(:ncol,:)/REAL(cld_macmic_num_steps,r8) + thlp2_clubb_gw(:ncol,:) = thlp2_clubb_gw_mc(:ncol,:)/REAL(cld_macmic_num_steps,r8) + wpthlp_clubb_gw(:ncol,:) = wpthlp_clubb_gw_mc(:ncol,:)/REAL(cld_macmic_num_steps,r8) + end if + do k=1, nlev+1 do i=1, ncol @@ -3699,18 +3927,34 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Now compute the tendencies of CLUBB to CAM, note that pverp is the ghost point ! for all variables and therefore is never called in this loop + rtm_integral_vtend(:) = 0._r8 + rtm_integral_ltend(:) = 0._r8 + do k=1, pver - do i=1, ncol + do i=1, ncol - ptend_loc%u(i,k) = (um(i,k) - state1%u(i,k)) / hdtime ! east-west wind - ptend_loc%v(i,k) = (vm(i,k) - state1%v(i,k)) / hdtime ! north-south wind - ptend_loc%q(i,k,ixq) = (rtm(i,k) - rcm(i,k)-state1%q(i,k,ixq)) / hdtime ! water vapor - ptend_loc%q(i,k,ixcldliq) = (rcm(i,k) - state1%q(i,k,ixcldliq)) / hdtime ! Tendency of liquid water - ptend_loc%s(i,k) = (clubb_s(i,k) - state1%s(i,k)) / hdtime ! Tendency of static energy + ptend_loc%u(i,k) = (um(i,k) - state1%u(i,k)) / hdtime ! east-west wind + ptend_loc%v(i,k) = (vm(i,k) - state1%v(i,k)) / hdtime ! north-south wind + ptend_loc%q(i,k,ixq) = (rtm(i,k) - rcm(i,k)-state1%q(i,k,ixq)) / hdtime ! water vapor + ptend_loc%q(i,k,ixcldliq) = (rcm(i,k) - state1%q(i,k,ixcldliq)) / hdtime ! Tendency of liquid water + ptend_loc%s(i,k) = (clubb_s(i,k) - state1%s(i,k)) / hdtime ! Tendency of static energy - end do + rtm_integral_ltend(i) = rtm_integral_ltend(i) + ptend_loc%q(i,k,ixcldliq)*state1%pdel(i,k) + rtm_integral_vtend(i) = rtm_integral_vtend(i) + ptend_loc%q(i,k,ixq)*state1%pdel(i,k) + + end do end do + rtm_integral_ltend(:) = rtm_integral_ltend(:)/gravit + rtm_integral_vtend(:) = rtm_integral_vtend(:)/gravit + + ! Accumulate Air Temperature Tendency (TTEND) for Gravity Wave parameterization + ttend_clubb_mc(:ncol,:pver) = ttend_clubb_mc(:ncol,:pver) + ptend_loc%s(:ncol,:pver)/cpair + + ! Average at last macmic step + if (macmic_it == cld_macmic_num_steps) then + ttend_clubb(:ncol,:) = ttend_clubb_mc(:ncol,:pver)/REAL(cld_macmic_num_steps,r8) + end if if (clubb_do_adv) then if (macmic_it == cld_macmic_num_steps) then @@ -4273,7 +4517,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if ! Output CLUBB history here - if (l_stats) then + if (stats_metadata%l_stats) then do j=1,stats_zt(1)%num_output_fields @@ -4293,7 +4537,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld(trim(sub),out_zm(:,:,j), pcols, lchnk) enddo - if (l_output_rad_files) then + if (stats_metadata%l_output_rad_files) then do j=1,stats_rad_zt(1)%num_output_fields call outfld(trim(stats_rad_zt(1)%file%grid_avg_var(j)%name), out_radzt(:,:,j), pcols, lchnk) enddo @@ -4523,57 +4767,6 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & !----------------------------------------------------------------------- - - use clubb_api_module, only: & - ztscr01, & - ztscr02, & - ztscr03, & - ztscr04, & - ztscr05, & - ztscr06, & - ztscr07, & - ztscr08, & - ztscr09, & - ztscr10, & - ztscr11, & - ztscr12, & - ztscr13, & - ztscr14, & - ztscr15, & - ztscr16, & - ztscr17, & - ztscr18, & - ztscr19, & - ztscr20, & - ztscr21 - - use clubb_api_module, only: & - zmscr01, & - zmscr02, & - zmscr03, & - zmscr04, & - zmscr05, & - zmscr06, & - zmscr07, & - zmscr08, & - zmscr09, & - zmscr10, & - zmscr11, & - zmscr12, & - zmscr13, & - zmscr14, & - zmscr15, & - zmscr16, & - zmscr17, & - l_stats, & - l_output_rad_files, & - stats_tsamp, & - stats_tout, & - l_stats_samp, & - l_stats_last, & - l_netcdf, & - l_grads - use clubb_api_module, only: time_precision, & ! nvarmax_zm, stats_init_zm_api, & ! nvarmax_zt, stats_init_zt_api, & ! @@ -4589,7 +4782,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & implicit none - ! Input Variables + !----------------------- Input Variables ----------------------- logical, intent(in) :: l_stats_in ! Stats on? T/F @@ -4603,15 +4796,16 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & real(kind=time_precision), intent(in) :: delt ! Timestep (dtmain in CLUBB) [s] - ! Output Variables - type (stats), intent(out) :: stats_zt, & ! stats_zt grid - stats_zm, & ! stats_zm grid - stats_rad_zt, & ! stats_rad_zt grid - stats_rad_zm, & ! stats_rad_zm grid - stats_sfc ! stats_sfc + !----------------------- Output Variables ----------------------- + type (stats), intent(out), dimension(pcols) :: & + stats_zt, & ! stats_zt grid + stats_zm, & ! stats_zm grid + stats_rad_zt, & ! stats_rad_zt grid + stats_rad_zm, & ! stats_rad_zm grid + stats_sfc ! stats_sfc - ! Local Variables + !----------------------- Local Variables ----------------------- ! Namelist Variables @@ -4630,28 +4824,27 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & clubb_vars_rad_zm, & clubb_vars_sfc - ! Local Variables - - logical :: l_error, & - first_call = .false. + logical :: l_error character(len=200) :: temp1, sub - integer :: i, ntot, read_status + integer :: i, ntot, read_status, j integer :: iunit, ierr + !----------------------- Begin Code ----------------------- + ! Initialize l_error = .false. ! Set stats_variables variables with inputs from calling subroutine - l_stats = l_stats_in - - stats_tsamp = stats_tsamp_in - stats_tout = stats_tout_in - - if ( .not. l_stats ) then - l_stats_samp = .false. - l_stats_last = .false. + stats_metadata%l_stats = l_stats_in + + stats_metadata%stats_tsamp = stats_tsamp_in + stats_metadata%stats_tout = stats_tout_in + + if ( .not. stats_metadata%l_stats ) then + stats_metadata%l_stats_samp = .false. + stats_metadata%l_stats_last = .false. return end if @@ -4690,296 +4883,226 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & call mpi_bcast(clubb_vars_sfc, var_length*nvarmax_sfc, mpi_character, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(subr//": FATAL: mpi_bcast: clubb_vars_sfc") + ! Hardcode these for use in CAM-CLUBB, don't want either - l_netcdf = .false. - l_grads = .false. + stats_metadata%l_netcdf = .false. + stats_metadata%l_grads = .false. ! Check sampling and output frequencies + do j = 1, pcols + + ! The model time step length, delt (which is dtmain), should multiply + ! evenly into the statistical sampling time step length, stats_tsamp. + if ( abs( stats_metadata%stats_tsamp/delt - floor(stats_metadata%stats_tsamp/delt) ) > 1.e-8_r8 ) then + l_error = .true. ! This will cause the run to stop. + write(fstderr,*) 'Error: stats_tsamp should be an even multiple of ', & + 'the clubb time step (delt below)' + write(fstderr,*) 'stats_tsamp = ', stats_metadata%stats_tsamp + write(fstderr,*) 'delt = ', delt + call endrun ("stats_init_clubb: CLUBB stats_tsamp must be an even multiple of the timestep") + endif - ! The model time step length, delt (which is dtmain), should multiply - ! evenly into the statistical sampling time step length, stats_tsamp. - if ( abs( stats_tsamp/delt - floor(stats_tsamp/delt) ) > 1.e-8_r8 ) then - l_error = .true. ! This will cause the run to stop. - write(fstderr,*) 'Error: stats_tsamp should be an even multiple of ', & - 'delt (which is dtmain). Check the appropriate ', & - 'model.in file.' - write(fstderr,*) 'stats_tsamp = ', stats_tsamp - write(fstderr,*) 'delt = ', delt - endif - - ! Initialize zt (mass points) - - i = 1 - do while ( ichar(clubb_vars_zt(i)(1:1)) /= 0 .and. & - len_trim(clubb_vars_zt(i)) /= 0 .and. & - i <= nvarmax_zt ) - i = i + 1 - enddo - ntot = i - 1 - if ( ntot == nvarmax_zt ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "clubb_vars_zt than allowed for by nvarmax_zt." - write(fstderr,*) "Check the number of variables listed for clubb_vars_zt ", & - "in the stats namelist, or change nvarmax_zt." - write(fstderr,*) "nvarmax_zt = ", nvarmax_zt - call endrun ("stats_init_clubb: number of zt statistical variables exceeds limit") - endif - - stats_zt%num_output_fields = ntot - stats_zt%kk = nnzp - - allocate( stats_zt%z( stats_zt%kk ) ) - - allocate( stats_zt%accum_field_values( 1, 1, stats_zt%kk, stats_zt%num_output_fields ) ) - allocate( stats_zt%accum_num_samples( 1, 1, stats_zt%kk, stats_zt%num_output_fields ) ) - allocate( stats_zt%l_in_update( 1, 1, stats_zt%kk, stats_zt%num_output_fields ) ) - call stats_zero( stats_zt%kk, stats_zt%num_output_fields, stats_zt%accum_field_values, & - stats_zt%accum_num_samples, stats_zt%l_in_update ) - - allocate( stats_zt%file%grid_avg_var( stats_zt%num_output_fields ) ) - allocate( stats_zt%file%z( stats_zt%kk ) ) - - first_call = (.not. allocated(ztscr01)) - - ! Allocate scratch space - if (first_call) allocate( ztscr01(stats_zt%kk) ) - if (first_call) allocate( ztscr02(stats_zt%kk) ) - if (first_call) allocate( ztscr03(stats_zt%kk) ) - if (first_call) allocate( ztscr04(stats_zt%kk) ) - if (first_call) allocate( ztscr05(stats_zt%kk) ) - if (first_call) allocate( ztscr06(stats_zt%kk) ) - if (first_call) allocate( ztscr07(stats_zt%kk) ) - if (first_call) allocate( ztscr08(stats_zt%kk) ) - if (first_call) allocate( ztscr09(stats_zt%kk) ) - if (first_call) allocate( ztscr10(stats_zt%kk) ) - if (first_call) allocate( ztscr11(stats_zt%kk) ) - if (first_call) allocate( ztscr12(stats_zt%kk) ) - if (first_call) allocate( ztscr13(stats_zt%kk) ) - if (first_call) allocate( ztscr14(stats_zt%kk) ) - if (first_call) allocate( ztscr15(stats_zt%kk) ) - if (first_call) allocate( ztscr16(stats_zt%kk) ) - if (first_call) allocate( ztscr17(stats_zt%kk) ) - if (first_call) allocate( ztscr18(stats_zt%kk) ) - if (first_call) allocate( ztscr19(stats_zt%kk) ) - if (first_call) allocate( ztscr20(stats_zt%kk) ) - if (first_call) allocate( ztscr21(stats_zt%kk) ) - - ztscr01 = 0.0_r8 - ztscr02 = 0.0_r8 - ztscr03 = 0.0_r8 - ztscr04 = 0.0_r8 - ztscr05 = 0.0_r8 - ztscr06 = 0.0_r8 - ztscr07 = 0.0_r8 - ztscr08 = 0.0_r8 - ztscr09 = 0.0_r8 - ztscr10 = 0.0_r8 - ztscr11 = 0.0_r8 - ztscr12 = 0.0_r8 - ztscr13 = 0.0_r8 - ztscr14 = 0.0_r8 - ztscr15 = 0.0_r8 - ztscr16 = 0.0_r8 - ztscr17 = 0.0_r8 - ztscr18 = 0.0_r8 - ztscr19 = 0.0_r8 - ztscr20 = 0.0_r8 - ztscr21 = 0.0_r8 - - ! Default initialization for array indices for zt - if (first_call) then - call stats_init_zt_api( clubb_vars_zt, l_error, & - stats_zt ) - end if - - ! Initialize zm (momentum points) - - i = 1 - do while ( ichar(clubb_vars_zm(i)(1:1)) /= 0 .and. & - len_trim(clubb_vars_zm(i)) /= 0 .and. & - i <= nvarmax_zm ) - i = i + 1 - end do - ntot = i - 1 - if ( ntot == nvarmax_zm ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "clubb_vars_zm than allowed for by nvarmax_zm." - write(fstderr,*) "Check the number of variables listed for clubb_vars_zm ", & - "in the stats namelist, or change nvarmax_zm." - write(fstderr,*) "nvarmax_zm = ", nvarmax_zm - call endrun ("stats_init_clubb: number of zm statistical variables exceeds limit") - endif - - stats_zm%num_output_fields = ntot - stats_zm%kk = nnzp - - allocate( stats_zm%z( stats_zm%kk ) ) - - allocate( stats_zm%accum_field_values( 1, 1, stats_zm%kk, stats_zm%num_output_fields ) ) - allocate( stats_zm%accum_num_samples( 1, 1, stats_zm%kk, stats_zm%num_output_fields ) ) - allocate( stats_zm%l_in_update( 1, 1, stats_zm%kk, stats_zm%num_output_fields ) ) - call stats_zero( stats_zm%kk, stats_zm%num_output_fields, stats_zm%accum_field_values, & - stats_zm%accum_num_samples, stats_zm%l_in_update ) - - allocate( stats_zm%file%grid_avg_var( stats_zm%num_output_fields ) ) - allocate( stats_zm%file%z( stats_zm%kk ) ) - - ! Allocate scratch space - - if (first_call) allocate( zmscr01(stats_zm%kk) ) - if (first_call) allocate( zmscr02(stats_zm%kk) ) - if (first_call) allocate( zmscr03(stats_zm%kk) ) - if (first_call) allocate( zmscr04(stats_zm%kk) ) - if (first_call) allocate( zmscr05(stats_zm%kk) ) - if (first_call) allocate( zmscr06(stats_zm%kk) ) - if (first_call) allocate( zmscr07(stats_zm%kk) ) - if (first_call) allocate( zmscr08(stats_zm%kk) ) - if (first_call) allocate( zmscr09(stats_zm%kk) ) - if (first_call) allocate( zmscr10(stats_zm%kk) ) - if (first_call) allocate( zmscr11(stats_zm%kk) ) - if (first_call) allocate( zmscr12(stats_zm%kk) ) - if (first_call) allocate( zmscr13(stats_zm%kk) ) - if (first_call) allocate( zmscr14(stats_zm%kk) ) - if (first_call) allocate( zmscr15(stats_zm%kk) ) - if (first_call) allocate( zmscr16(stats_zm%kk) ) - if (first_call) allocate( zmscr17(stats_zm%kk) ) - - zmscr01 = 0.0_r8 - zmscr02 = 0.0_r8 - zmscr03 = 0.0_r8 - zmscr04 = 0.0_r8 - zmscr05 = 0.0_r8 - zmscr06 = 0.0_r8 - zmscr07 = 0.0_r8 - zmscr08 = 0.0_r8 - zmscr09 = 0.0_r8 - zmscr10 = 0.0_r8 - zmscr11 = 0.0_r8 - zmscr12 = 0.0_r8 - zmscr13 = 0.0_r8 - zmscr14 = 0.0_r8 - zmscr15 = 0.0_r8 - zmscr16 = 0.0_r8 - zmscr17 = 0.0_r8 - - if (first_call) then - call stats_init_zm_api( clubb_vars_zm, l_error, & - stats_zm ) - end if - - ! Initialize rad_zt (radiation points) - - if (l_output_rad_files) then - - i = 1 - do while ( ichar(clubb_vars_rad_zt(i)(1:1)) /= 0 .and. & - len_trim(clubb_vars_rad_zt(i)) /= 0 .and. & - i <= nvarmax_rad_zt ) - i = i + 1 - end do - ntot = i - 1 - if ( ntot == nvarmax_rad_zt ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "clubb_vars_rad_zt than allowed for by nvarmax_rad_zt." - write(fstderr,*) "Check the number of variables listed for clubb_vars_rad_zt ", & - "in the stats namelist, or change nvarmax_rad_zt." - write(fstderr,*) "nvarmax_rad_zt = ", nvarmax_rad_zt - call endrun ("stats_init_clubb: number of rad_zt statistical variables exceeds limit") - endif - - stats_rad_zt%num_output_fields = ntot - stats_rad_zt%kk = nnrad_zt - - allocate( stats_rad_zt%z( stats_rad_zt%kk ) ) - - allocate( stats_rad_zt%accum_field_values( 1, 1, stats_rad_zt%kk, stats_rad_zt%num_output_fields ) ) - allocate( stats_rad_zt%accum_num_samples( 1, 1, stats_rad_zt%kk, stats_rad_zt%num_output_fields ) ) - allocate( stats_rad_zt%l_in_update( 1, 1, stats_rad_zt%kk, stats_rad_zt%num_output_fields ) ) - - call stats_zero( stats_rad_zt%kk, stats_rad_zt%num_output_fields, stats_rad_zt%accum_field_values, & - stats_rad_zt%accum_num_samples, stats_rad_zt%l_in_update ) - - allocate( stats_rad_zt%file%grid_avg_var( stats_rad_zt%num_output_fields ) ) - allocate( stats_rad_zt%file%z( stats_rad_zt%kk ) ) - - call stats_init_rad_zt_api( clubb_vars_rad_zt, l_error, & - stats_rad_zt ) - - ! Initialize rad_zm (radiation points) - - i = 1 - do while ( ichar(clubb_vars_rad_zm(i)(1:1)) /= 0 .and. & - len_trim(clubb_vars_rad_zm(i)) /= 0 .and. & - i <= nvarmax_rad_zm ) - i = i + 1 - end do - ntot = i - 1 - if ( ntot == nvarmax_rad_zm ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "clubb_vars_rad_zm than allowed for by nvarmax_rad_zm." - write(fstderr,*) "Check the number of variables listed for clubb_vars_rad_zm ", & - "in the stats namelist, or change nvarmax_rad_zm." - write(fstderr,*) "nvarmax_rad_zm = ", nvarmax_rad_zm - call endrun ("stats_init_clubb: number of rad_zm statistical variables exceeds limit") - endif + ! Initialize zt (mass points) - stats_rad_zm%num_output_fields = ntot - stats_rad_zm%kk = nnrad_zm + i = 1 + do while ( ichar(clubb_vars_zt(i)(1:1)) /= 0 .and. & + len_trim(clubb_vars_zt(i)) /= 0 .and. & + i <= nvarmax_zt ) + i = i + 1 + enddo + ntot = i - 1 + if ( ntot == nvarmax_zt ) then + l_error = .true. + write(fstderr,*) "There are more statistical variables listed in ", & + "clubb_vars_zt than allowed for by nvarmax_zt." + write(fstderr,*) "Check the number of variables listed for clubb_vars_zt ", & + "in the stats namelist, or change nvarmax_zt." + write(fstderr,*) "nvarmax_zt = ", nvarmax_zt + call endrun ("stats_init_clubb: number of zt statistical variables exceeds limit") + endif - allocate( stats_rad_zm%z( stats_rad_zm%kk ) ) + stats_zt(j)%num_output_fields = ntot + stats_zt(j)%kk = nnzp + + allocate( stats_zt(j)%z( stats_zt(j)%kk ), stat=ierr ) + if( ierr /= 0 ) call endrun("stats_init_clubb: Failed to allocate stats_zt%z") + + allocate( stats_zt(j)%accum_field_values( 1, 1, stats_zt(j)%kk, stats_zt(j)%num_output_fields ), stat=ierr ) + if( ierr /= 0 ) call endrun("stats_init_clubb: Failed to allocate stats_zt%accum_field_values") + allocate( stats_zt(j)%accum_num_samples( 1, 1, stats_zt(j)%kk, stats_zt(j)%num_output_fields ), stat=ierr ) + if( ierr /= 0 ) call endrun("stats_init_clubb: Failed to allocate stats_zt%accum_num_samples") + allocate( stats_zt(j)%l_in_update( 1, 1, stats_zt(j)%kk, stats_zt(j)%num_output_fields ), stat=ierr ) + if( ierr /= 0 ) call endrun("stats_init_clubb: Failed to allocate stats_zt%l_in_update") + call stats_zero( stats_zt(j)%kk, stats_zt(j)%num_output_fields, stats_zt(j)%accum_field_values, & + stats_zt(j)%accum_num_samples, stats_zt(j)%l_in_update ) + + allocate( stats_zt(j)%file%grid_avg_var( stats_zt(j)%num_output_fields ), stat=ierr ) + if( ierr /= 0 ) call endrun("stats_init_clubb: Failed to allocate stats_zt%file%grid_avg_var") + allocate( stats_zt(j)%file%z( stats_zt(j)%kk ), stat=ierr ) + if( ierr /= 0 ) call endrun("stats_init_clubb: Failed to allocate stats_zt%file%z") + + ! Default initialization for array indices for zt + call stats_init_zt_api( hydromet_dim, sclr_dim, edsclr_dim, & + hm_metadata%hydromet_list, hm_metadata%l_mix_rat_hm, & + clubb_vars_zt, & + l_error, & + stats_metadata, stats_zt(j) ) + + ! Initialize zm (momentum points) + + i = 1 + do while ( ichar(clubb_vars_zm(i)(1:1)) /= 0 .and. & + len_trim(clubb_vars_zm(i)) /= 0 .and. & + i <= nvarmax_zm ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_zm ) then + l_error = .true. ! This will cause the run to stop. + write(fstderr,*) "There are more statistical variables listed in ", & + "clubb_vars_zm than allowed for by nvarmax_zm." + write(fstderr,*) "Check the number of variables listed for clubb_vars_zm ", & + "in the stats namelist, or change nvarmax_zm." + write(fstderr,*) "nvarmax_zm = ", nvarmax_zm + call endrun ("stats_init_clubb: number of zm statistical variables exceeds limit") + endif - allocate( stats_rad_zm%accum_field_values( 1, 1, stats_rad_zm%kk, stats_rad_zm%num_output_fields ) ) - allocate( stats_rad_zm%accum_num_samples( 1, 1, stats_rad_zm%kk, stats_rad_zm%num_output_fields ) ) - allocate( stats_rad_zm%l_in_update( 1, 1, stats_rad_zm%kk, stats_rad_zm%num_output_fields ) ) + stats_zm(j)%num_output_fields = ntot + stats_zm(j)%kk = nnzp + + allocate( stats_zm(j)%z( stats_zm(j)%kk ) ) + + allocate( stats_zm(j)%accum_field_values( 1, 1, stats_zm(j)%kk, stats_zm(j)%num_output_fields ) ) + allocate( stats_zm(j)%accum_num_samples( 1, 1, stats_zm(j)%kk, stats_zm(j)%num_output_fields ) ) + allocate( stats_zm(j)%l_in_update( 1, 1, stats_zm(j)%kk, stats_zm(j)%num_output_fields ) ) + call stats_zero( stats_zm(j)%kk, stats_zm(j)%num_output_fields, stats_zm(j)%accum_field_values, & + stats_zm(j)%accum_num_samples, stats_zm(j)%l_in_update ) + + allocate( stats_zm(j)%file%grid_avg_var( stats_zm(j)%num_output_fields ) ) + allocate( stats_zm(j)%file%z( stats_zm(j)%kk ) ) + + call stats_init_zm_api( hydromet_dim, sclr_dim, edsclr_dim, & + hm_metadata%hydromet_list, hm_metadata%l_mix_rat_hm, & + clubb_vars_zm, & + l_error, & + stats_metadata, stats_zm(j) ) + + ! Initialize rad_zt (radiation points) + + if (stats_metadata%l_output_rad_files) then + + i = 1 + do while ( ichar(clubb_vars_rad_zt(i)(1:1)) /= 0 .and. & + len_trim(clubb_vars_rad_zt(i)) /= 0 .and. & + i <= nvarmax_rad_zt ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_rad_zt ) then + write(fstderr,*) "There are more statistical variables listed in ", & + "clubb_vars_rad_zt than allowed for by nvarmax_rad_zt." + write(fstderr,*) "Check the number of variables listed for clubb_vars_rad_zt ", & + "in the stats namelist, or change nvarmax_rad_zt." + write(fstderr,*) "nvarmax_rad_zt = ", nvarmax_rad_zt + call endrun ("stats_init_clubb: number of rad_zt statistical variables exceeds limit") + endif + + stats_rad_zt(j)%num_output_fields = ntot + stats_rad_zt(j)%kk = nnrad_zt + + allocate( stats_rad_zt(j)%z( stats_rad_zt(j)%kk ) ) + + allocate( stats_rad_zt(j)%accum_field_values( 1, 1, stats_rad_zt(j)%kk, stats_rad_zt(j)%num_output_fields ) ) + allocate( stats_rad_zt(j)%accum_num_samples( 1, 1, stats_rad_zt(j)%kk, stats_rad_zt(j)%num_output_fields ) ) + allocate( stats_rad_zt(j)%l_in_update( 1, 1, stats_rad_zt(j)%kk, stats_rad_zt(j)%num_output_fields ) ) + + call stats_zero( stats_rad_zt(j)%kk, stats_rad_zt(j)%num_output_fields, stats_rad_zt(j)%accum_field_values, & + stats_rad_zt(j)%accum_num_samples, stats_rad_zt(j)%l_in_update ) + + allocate( stats_rad_zt(j)%file%grid_avg_var( stats_rad_zt(j)%num_output_fields ) ) + allocate( stats_rad_zt(j)%file%z( stats_rad_zt(j)%kk ) ) + + call stats_init_rad_zt_api( clubb_vars_rad_zt, & + l_error, & + stats_metadata, stats_rad_zt(j) ) + + ! Initialize rad_zm (radiation points) + + i = 1 + do while ( ichar(clubb_vars_rad_zm(i)(1:1)) /= 0 .and. & + len_trim(clubb_vars_rad_zm(i)) /= 0 .and. & + i <= nvarmax_rad_zm ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_rad_zm ) then + l_error = .true. ! This will cause the run to stop. + write(fstderr,*) "There are more statistical variables listed in ", & + "clubb_vars_rad_zm than allowed for by nvarmax_rad_zm." + write(fstderr,*) "Check the number of variables listed for clubb_vars_rad_zm ", & + "in the stats namelist, or change nvarmax_rad_zm." + write(fstderr,*) "nvarmax_rad_zm = ", nvarmax_rad_zm + call endrun ("stats_init_clubb: number of rad_zm statistical variables exceeds limit") + endif + + stats_rad_zm(j)%num_output_fields = ntot + stats_rad_zm(j)%kk = nnrad_zm + + allocate( stats_rad_zm(j)%z( stats_rad_zm(j)%kk ) ) + + allocate( stats_rad_zm(j)%accum_field_values( 1, 1, stats_rad_zm(j)%kk, stats_rad_zm(j)%num_output_fields ) ) + allocate( stats_rad_zm(j)%accum_num_samples( 1, 1, stats_rad_zm(j)%kk, stats_rad_zm(j)%num_output_fields ) ) + allocate( stats_rad_zm(j)%l_in_update( 1, 1, stats_rad_zm(j)%kk, stats_rad_zm(j)%num_output_fields ) ) + + call stats_zero( stats_rad_zm(j)%kk, stats_rad_zm(j)%num_output_fields, stats_rad_zm(j)%accum_field_values, & + stats_rad_zm(j)%accum_num_samples, stats_rad_zm(j)%l_in_update ) + + allocate( stats_rad_zm(j)%file%grid_avg_var( stats_rad_zm(j)%num_output_fields ) ) + allocate( stats_rad_zm(j)%file%z( stats_rad_zm(j)%kk ) ) + + call stats_init_rad_zm_api( clubb_vars_rad_zm, & + l_error, & + stats_metadata, stats_rad_zm(j) ) + end if ! l_output_rad_files + + + ! Initialize sfc (surface point) + i = 1 + do while ( ichar(clubb_vars_sfc(i)(1:1)) /= 0 .and. & + len_trim(clubb_vars_sfc(i)) /= 0 .and. & + i <= nvarmax_sfc ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_sfc ) then + l_error = .true. ! This will cause the run to stop. + write(fstderr,*) "There are more statistical variables listed in ", & + "clubb_vars_sfc than allowed for by nvarmax_sfc." + write(fstderr,*) "Check the number of variables listed for clubb_vars_sfc ", & + "in the stats namelist, or change nvarmax_sfc." + write(fstderr,*) "nvarmax_sfc = ", nvarmax_sfc + call endrun ("stats_init_clubb: number of sfc statistical variables exceeds limit") + endif - call stats_zero( stats_rad_zm%kk, stats_rad_zm%num_output_fields, stats_rad_zm%accum_field_values, & - stats_rad_zm%accum_num_samples, stats_rad_zm%l_in_update ) + stats_sfc(j)%num_output_fields = ntot + stats_sfc(j)%kk = 1 - allocate( stats_rad_zm%file%grid_avg_var( stats_rad_zm%num_output_fields ) ) - allocate( stats_rad_zm%file%z( stats_rad_zm%kk ) ) + allocate( stats_sfc(j)%z( stats_sfc(j)%kk ) ) - call stats_init_rad_zm_api( clubb_vars_rad_zm, l_error, & - stats_rad_zm ) - end if ! l_output_rad_files + allocate( stats_sfc(j)%accum_field_values( 1, 1, stats_sfc(j)%kk, stats_sfc(j)%num_output_fields ) ) + allocate( stats_sfc(j)%accum_num_samples( 1, 1, stats_sfc(j)%kk, stats_sfc(j)%num_output_fields ) ) + allocate( stats_sfc(j)%l_in_update( 1, 1, stats_sfc(j)%kk, stats_sfc(j)%num_output_fields ) ) + call stats_zero( stats_sfc(j)%kk, stats_sfc(j)%num_output_fields, stats_sfc(j)%accum_field_values, & + stats_sfc(j)%accum_num_samples, stats_sfc(j)%l_in_update ) - ! Initialize sfc (surface point) + allocate( stats_sfc(j)%file%grid_avg_var( stats_sfc(j)%num_output_fields ) ) + allocate( stats_sfc(j)%file%z( stats_sfc(j)%kk ) ) - i = 1 - do while ( ichar(clubb_vars_sfc(i)(1:1)) /= 0 .and. & - len_trim(clubb_vars_sfc(i)) /= 0 .and. & - i <= nvarmax_sfc ) - i = i + 1 + call stats_init_sfc_api( clubb_vars_sfc, & + l_error, & + stats_metadata, stats_sfc(j) ) end do - ntot = i - 1 - if ( ntot == nvarmax_sfc ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "clubb_vars_sfc than allowed for by nvarmax_sfc." - write(fstderr,*) "Check the number of variables listed for clubb_vars_sfc ", & - "in the stats namelist, or change nvarmax_sfc." - write(fstderr,*) "nvarmax_sfc = ", nvarmax_sfc - call endrun ("stats_init_clubb: number of sfc statistical variables exceeds limit") - endif - - stats_sfc%num_output_fields = ntot - stats_sfc%kk = 1 - - allocate( stats_sfc%z( stats_sfc%kk ) ) - - allocate( stats_sfc%accum_field_values( 1, 1, stats_sfc%kk, stats_sfc%num_output_fields ) ) - allocate( stats_sfc%accum_num_samples( 1, 1, stats_sfc%kk, stats_sfc%num_output_fields ) ) - allocate( stats_sfc%l_in_update( 1, 1, stats_sfc%kk, stats_sfc%num_output_fields ) ) - - call stats_zero( stats_sfc%kk, stats_sfc%num_output_fields, stats_sfc%accum_field_values, & - stats_sfc%accum_num_samples, stats_sfc%l_in_update ) - - allocate( stats_sfc%file%grid_avg_var( stats_sfc%num_output_fields ) ) - allocate( stats_sfc%file%z( stats_sfc%kk ) ) - - if (first_call) then - call stats_init_sfc_api( clubb_vars_sfc, l_error, & - stats_sfc ) - end if ! Check for errors @@ -4987,48 +5110,60 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & call endrun ('stats_init: errors found') endif -! Now call add fields - if (first_call) then + ! Now call add fields - do i = 1, stats_zt%num_output_fields + do i = 1, stats_zt(1)%num_output_fields - temp1 = trim(stats_zt%file%grid_avg_var(i)%name) - sub = temp1 - if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len) + temp1 = trim(stats_zt(1)%file%grid_avg_var(i)%name) + sub = temp1 + if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len) - call addfld(trim(sub),(/ 'ilev' /),& - 'A',trim(stats_zt%file%grid_avg_var(i)%units),trim(stats_zt%file%grid_avg_var(i)%description)) - enddo + call addfld( trim(sub), (/ 'ilev' /), 'A', & + trim(stats_zt(1)%file%grid_avg_var(i)%units), & + trim(stats_zt(1)%file%grid_avg_var(i)%description) ) + enddo - do i = 1, stats_zm%num_output_fields + do i = 1, stats_zm(1)%num_output_fields - temp1 = trim(stats_zm%file%grid_avg_var(i)%name) - sub = temp1 - if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len) + temp1 = trim(stats_zm(1)%file%grid_avg_var(i)%name) + sub = temp1 + if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len) - call addfld(trim(sub),(/ 'ilev' /),& - 'A',trim(stats_zm%file%grid_avg_var(i)%units),trim(stats_zm%file%grid_avg_var(i)%description)) - enddo + call addfld( trim(sub), (/ 'ilev' /), 'A', & + trim(stats_zm(1)%file%grid_avg_var(i)%units), & + trim(stats_zm(1)%file%grid_avg_var(i)%description) ) + enddo - if (l_output_rad_files) then + if (stats_metadata%l_output_rad_files) then - do i = 1, stats_rad_zt%num_output_fields - call addfld(trim(stats_rad_zt%file%grid_avg_var(i)%name),(/ 'ilev' /),& - 'A',trim(stats_rad_zt%file%grid_avg_var(i)%units),trim(stats_rad_zt%file%grid_avg_var(i)%description)) - enddo + do i = 1, stats_rad_zt(1)%num_output_fields + temp1 = trim(stats_rad_zt(1)%file%grid_avg_var(i)%name) + sub = temp1 + if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len) + call addfld( trim(sub), (/ 'ilev' /), 'A', & + trim(stats_rad_zt(1)%file%grid_avg_var(i)%units), & + trim(stats_rad_zt(1)%file%grid_avg_var(i)%description) ) + enddo - do i = 1, stats_rad_zm%num_output_fields - call addfld(trim(stats_rad_zm%file%grid_avg_var(i)%name),(/ 'ilev' /),& - 'A',trim(stats_rad_zm%file%grid_avg_var(i)%units),trim(stats_rad_zm%file%grid_avg_var(i)%description)) - enddo - endif + do i = 1, stats_rad_zm(1)%num_output_fields + temp1 = trim(stats_rad_zm(1)%file%grid_avg_var(i)%name) + sub = temp1 + if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len) + call addfld( trim(sub), (/ 'ilev' /), 'A', & + trim(stats_rad_zm(1)%file%grid_avg_var(i)%units), & + trim(stats_rad_zm(1)%file%grid_avg_var(i)%description) ) + enddo + endif - do i = 1, stats_sfc%num_output_fields - call addfld(trim(stats_sfc%file%grid_avg_var(i)%name),horiz_only,& - 'A',trim(stats_sfc%file%grid_avg_var(i)%units),trim(stats_sfc%file%grid_avg_var(i)%description)) - enddo + do i = 1, stats_sfc(1)%num_output_fields + temp1 = trim(stats_sfc(1)%file%grid_avg_var(i)%name) + sub = temp1 + if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len) + call addfld( trim(sub), horiz_only, 'A', & + trim(stats_sfc(1)%file%grid_avg_var(i)%units), & + trim(stats_sfc(1)%file%grid_avg_var(i)%description) ) + enddo - end if return @@ -5055,10 +5190,6 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st use clubb_api_module, only: & fstderr, & ! Constant(s) - l_stats_last, & - stats_tsamp, & - stats_tout, & - l_output_rad_files, & clubb_at_least_debug_level_api ! Procedure(s) use cam_abortutils, only: endrun @@ -5088,7 +5219,7 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st ! Check if it is time to write to file - if ( .not. l_stats_last ) return + if ( .not. stats_metadata%l_stats_last ) return ! Initialize l_error = .false. @@ -5096,7 +5227,7 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st ! Compute averages call stats_avg( stats_zt%kk, stats_zt%num_output_fields, stats_zt%accum_field_values, stats_zt%accum_num_samples ) call stats_avg( stats_zm%kk, stats_zm%num_output_fields, stats_zm%accum_field_values, stats_zm%accum_num_samples ) - if (l_output_rad_files) then + if (stats_metadata%l_output_rad_files) then call stats_avg( stats_rad_zt%kk, stats_rad_zt%num_output_fields, stats_rad_zt%accum_field_values, & stats_rad_zt%accum_num_samples ) call stats_avg( stats_rad_zm%kk, stats_rad_zm%num_output_fields, stats_rad_zm%accum_field_values, & @@ -5121,7 +5252,7 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st enddo enddo - if (l_output_rad_files) then + if (stats_metadata%l_output_rad_files) then do i = 1, stats_rad_zt%num_output_fields do k = 1, stats_rad_zt%kk out_radzt(thecol,pverp-k+1,i) = stats_rad_zt%accum_field_values(1,1,k,i) @@ -5154,7 +5285,7 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st stats_zt%accum_num_samples, stats_zt%l_in_update ) call stats_zero( stats_zm%kk, stats_zm%num_output_fields, stats_zm%accum_field_values, & stats_zm%accum_num_samples, stats_zm%l_in_update ) - if (l_output_rad_files) then + if (stats_metadata%l_output_rad_files) then call stats_zero( stats_rad_zt%kk, stats_rad_zt%num_output_fields, stats_rad_zt%accum_field_values, & stats_rad_zt%accum_num_samples, stats_rad_zt%l_in_update ) call stats_zero( stats_rad_zm%kk, stats_rad_zm%num_output_fields, stats_rad_zm%accum_field_values, & diff --git a/src/physics/cam/convect_deep.F90 b/src/physics/cam/convect_deep.F90 index edd2043623..ebba3ba9fa 100644 --- a/src/physics/cam/convect_deep.F90 +++ b/src/physics/cam/convect_deep.F90 @@ -5,7 +5,7 @@ module convect_deep ! ! CAM interface to several deep convection interfaces. Currently includes: ! Zhang-McFarlane (default) -! Kerry Emanuel +! Kerry Emanuel ! ! ! Author: D.B. Coleman, Sep 2004 @@ -28,34 +28,34 @@ module convect_deep convect_deep_tend, &! return tendencies convect_deep_tend_2, &! return tendencies deep_scheme_does_scav_trans ! = .t. if scheme does scavenging and conv. transport - + ! Private module data character(len=16) :: deep_scheme ! default set in phys_control.F90, use namelist to change -! Physics buffer indices - integer :: icwmrdp_idx = 0 - integer :: rprddp_idx = 0 - integer :: nevapr_dpcu_idx = 0 - integer :: cldtop_idx = 0 - integer :: cldbot_idx = 0 - integer :: cld_idx = 0 - integer :: fracis_idx = 0 - - integer :: pblh_idx = 0 - integer :: tpert_idx = 0 +! Physics buffer indices + integer :: icwmrdp_idx = 0 + integer :: rprddp_idx = 0 + integer :: nevapr_dpcu_idx = 0 + integer :: cldtop_idx = 0 + integer :: cldbot_idx = 0 + integer :: cld_idx = 0 + integer :: fracis_idx = 0 + + integer :: pblh_idx = 0 + integer :: tpert_idx = 0 integer :: prec_dp_idx = 0 integer :: snow_dp_idx = 0 integer :: ttend_dp_idx = 0 !========================================================================================= - contains + contains !========================================================================================= function deep_scheme_does_scav_trans() ! ! Function called by tphysbc to determine if it needs to do scavenging and convective transport ! or if those have been done by the deep convection scheme. Each scheme could have its own -! identical query function for a less-knowledgable interface but for now, we know that KE +! identical query function for a less-knowledgable interface but for now, we know that KE ! does scavenging & transport, and ZM doesn't ! @@ -76,7 +76,7 @@ subroutine convect_deep_register ! Purpose: register fields with the physics buffer !---------------------------------------- - + use physics_buffer, only : pbuf_add_field, dtype_r8 use zm_conv_intr, only: zm_conv_register use phys_control, only: phys_getopts, use_gw_convect_dp @@ -118,12 +118,12 @@ subroutine convect_deep_init(pref_edge) ! Purpose: declare output fields, initialize variables needed by convection !---------------------------------------- - use cam_history, only: addfld + use cam_history, only: addfld use pmgrid, only: plevp use spmd_utils, only: masterproc use zm_conv_intr, only: zm_conv_init use cam_abortutils, only: endrun - + use physics_buffer, only: physics_buffer_desc, pbuf_get_index implicit none @@ -169,14 +169,14 @@ end subroutine convect_deep_init subroutine convect_deep_tend( & mcon ,cme , & - pflx ,zdu , & + zdu , & rliq ,rice , & ztodt , & state ,ptend ,landfrac ,pbuf) use physics_types, only: physics_state, physics_ptend, physics_tend, physics_ptend_init - + use cam_history, only: outfld use constituents, only: pcnst use zm_conv_intr, only: zm_conv_tend @@ -187,15 +187,14 @@ subroutine convect_deep_tend( & ! Arguments type(physics_state), intent(in ) :: state ! Physics state variables type(physics_ptend), intent(out) :: ptend ! individual parameterization tendencies - + type(physics_buffer_desc), pointer :: pbuf(:) real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) real(r8), intent(in) :: landfrac(pcols) ! Land fraction - + real(r8), intent(out) :: mcon(pcols,pverp) ! Convective mass flux--m sub c - real(r8), intent(out) :: pflx(pcols,pverp) ! scattered precip flux at each level real(r8), intent(out) :: cme(pcols,pver) ! cmf condensation - evaporation real(r8), intent(out) :: zdu(pcols,pver) ! detraining mass flux @@ -203,11 +202,11 @@ subroutine convect_deep_tend( & real(r8), intent(out) :: rice(pcols) ! reserved ice (not yet in cldice) for energy integrals real(r8), pointer :: prec(:) ! total precipitation - real(r8), pointer :: snow(:) ! snow from ZM convection + real(r8), pointer :: snow(:) ! snow from ZM convection real(r8), pointer, dimension(:) :: jctop real(r8), pointer, dimension(:) :: jcbot - real(r8), pointer, dimension(:,:,:) :: cld + real(r8), pointer, dimension(:,:,:) :: cld real(r8), pointer, dimension(:,:) :: ql ! wg grid slice of cloud liquid water. real(r8), pointer, dimension(:,:) :: rprd ! rain production rate real(r8), pointer, dimension(:,:,:) :: fracis ! fraction of transported species that are insoluble @@ -230,9 +229,8 @@ subroutine convect_deep_tend( & select case ( deep_scheme ) case('off', 'UNICON', 'CLUBB_SGS') ! in UNICON case the run method is called from convect_shallow_tend - zero = 0 + zero = 0 mcon = 0 - pflx = 0 cme = 0 zdu = 0 rliq = 0 @@ -244,7 +242,7 @@ subroutine convect_deep_tend( & ! Associate pointers with physics buffer fields ! - call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1/), kount=(/pcols,pver/) ) + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1/), kount=(/pcols,pver/) ) call pbuf_get_field(pbuf, rprddp_idx, rprd ) call pbuf_get_field(pbuf, fracis_idx, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) ) call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp ) @@ -267,7 +265,7 @@ subroutine convect_deep_tend( & call pbuf_get_field(pbuf, tpert_idx, tpert) call zm_conv_tend( pblh ,mcon ,cme , & - tpert ,pflx ,zdu , & + tpert ,zdu , & rliq ,rice , & ztodt , & jctop, jcbot , & @@ -291,7 +289,7 @@ end subroutine convect_deep_tend subroutine convect_deep_tend_2( state, ptend, ztodt, pbuf) use physics_types, only: physics_state, physics_ptend, physics_ptend_init - + use physics_buffer, only: physics_buffer_desc use constituents, only: pcnst use zm_conv_intr, only: zm_conv_tend_2 @@ -299,14 +297,14 @@ subroutine convect_deep_tend_2( state, ptend, ztodt, pbuf) ! Arguments type(physics_state), intent(in ) :: state ! Physics state variables type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies - + type(physics_buffer_desc), pointer :: pbuf(:) real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) if ( deep_scheme .eq. 'ZM' ) then ! Zhang-McFarlane - call zm_conv_tend_2( state, ptend, ztodt, pbuf) + call zm_conv_tend_2( state, ptend, ztodt, pbuf) else call physics_ptend_init(ptend, state%psetcols, 'convect_deep') end if diff --git a/src/physics/cam/cospsimulator_intr.F90 b/src/physics/cam/cospsimulator_intr.F90 index 6a01415f04..7db2792a12 100644 --- a/src/physics/cam/cospsimulator_intr.F90 +++ b/src/physics/cam/cospsimulator_intr.F90 @@ -13,14 +13,15 @@ module cospsimulator_intr use shr_kind_mod, only: r8 => shr_kind_r8 use spmd_utils, only: masterproc use ppgrid, only: pcols, pver, pverp, begchunk, endchunk + use ref_pres, only: ktop => trop_cloud_top_lev use perf_mod, only: t_startf, t_stopf - use cam_abortutils, only: endrun + use cam_abortutils, only: endrun, handle_allocate_error use phys_control, only: cam_physpkg_is use cam_logfile, only: iulog #ifdef USE_COSP use quickbeam, only: radar_cfg use mod_quickbeam_optics, only: size_distribution - use mod_cosp, only: cosp_outputs,cosp_optical_inputs,cosp_column_inputs + use mod_cosp, only: cosp_outputs, cosp_optical_inputs, cosp_column_inputs use mod_cosp_config, only: pres_binCenters, pres_binEdges, tau_binCenters, & tau_binEdges, cloudsat_binCenters, cloudsat_binEdges, calipso_binCenters, & calipso_binEdges, misr_histHgtCenters, misr_histHgtEdges, PARASOL_SZA, & @@ -56,22 +57,23 @@ module cospsimulator_intr ! ###################################################################################### ! Whether to do COSP calcs and I/O, default is false. If docosp is specified in ! the atm_in namelist, this value is overwritten and cosp is run - logical, public :: docosp = .false. + logical, public, protected :: docosp = .false. ! Frequency at which cosp is called, every cosp_nradsteps radiation timestep - integer, public :: cosp_nradsteps = 1! CAM namelist variable default, not in COSP namelist + integer, public, protected :: cosp_nradsteps = 1 #ifdef USE_COSP ! ###################################################################################### ! Local declarations ! ###################################################################################### - integer, parameter :: & - nhtml_cosp = pver ! Mumber of model levels is pver integer :: & - nscol_cosp, & ! Number of subcolumns, use namelist input Ncolumns to set. + nlay, & ! Number of CAM layers used by COSP. + nlayp, & ! Number of CAM layer interfaces used by COSP. + nscol_cosp, & ! Number of subcolumns, allow namelist input to set. nht_cosp ! Number of height for COSP radar and calipso simulator outputs. ! *set to 40 if csat_vgrid=.true., else set to Nlr* + ! ###################################################################################### ! Bin-boundaries for mixed dimensions. Calculated in cospsetupvales OR in cosp_config.F90 @@ -94,7 +96,6 @@ module cospsimulator_intr real(r8), target :: reffICE_binCenters_cosp(numMODISReffIceBins) real(r8), target :: reffLIQ_binCenters_cosp(numMODISReffLiqBins) - real(r8) :: htmlmid_cosp(nhtml_cosp) ! Model level height midpoints for output integer :: prstau_cosp(nprs_cosp*ntau_cosp) ! ISCCP mixed output dimension index integer :: prstau_cosp_modis(nprs_cosp*ntau_cosp_modis) ! MODIS mixed output dimension index integer :: htmisrtau_cosp(nhtmisr_cosp*ntau_cosp) ! MISR mixed output dimension index @@ -104,6 +105,7 @@ module cospsimulator_intr real(r8) :: prstau_taumid_cosp_modis(nprs_cosp*ntau_cosp_modis) real(r8) :: htmisrtau_htmisrmid_cosp(nhtmisr_cosp*ntau_cosp) real(r8) :: htmisrtau_taumid_cosp(nhtmisr_cosp*ntau_cosp) + real(r8),allocatable :: htmlmid_cosp(:) ! Model level height midpoints for output (nlay) real(r8),allocatable, public :: htdbze_dbzemid_cosp(:) ! (nht_cosp*CLOUDSAT_DBZE_BINS) real(r8),allocatable, target :: htlim_cosp(:,:) ! height limits for COSP outputs (nht_cosp+1) real(r8),allocatable, target :: htmid_cosp(:) ! height midpoints of COSP radar/lidar output (nht_cosp) @@ -111,73 +113,64 @@ module cospsimulator_intr real(r8),allocatable :: htdbze_htmid_cosp(:) ! (nht_cosp*CLOUDSAT_DBZE_BINS) real(r8),allocatable :: htsr_htmid_cosp(:) ! (nht_cosp*nsr_cosp) real(r8),allocatable :: htsr_srmid_cosp(:) ! (nht_cosp*nsr_cosp) - real(r8),allocatable :: htmlscol_htmlmid_cosp(:) ! (nhtml_cosp*nscol_cosp) - real(r8),allocatable :: htmlscol_scol_cosp(:) ! (nhtml_cosp*nscol_cosp) + real(r8),allocatable :: htmlscol_htmlmid_cosp(:) ! (nlay*nscol_cosp) + real(r8),allocatable :: htmlscol_scol_cosp(:) ! (nlay*nscol_cosp) integer, allocatable, target :: scol_cosp(:) ! sub-column number (nscol_cosp) integer, allocatable :: htdbze_cosp(:) ! radar CFAD mixed output dimension index (nht_cosp*CLOUDSAT_DBZE_BINS) integer, allocatable :: htsr_cosp(:) ! lidar CFAD mixed output dimension index (nht_cosp*nsr_cosp) - integer, allocatable :: htmlscol_cosp(:) ! html-subcolumn mixed output dimension index (nhtml_cosp*nscol_cosp) + integer, allocatable :: htmlscol_cosp(:) ! html-subcolumn mixed output dimension index (nlay*nscol_cosp) ! ###################################################################################### - ! Default namelists - ! The CAM and COSP namelists defaults are set below. Some of the COSP namelist - ! variables are part of the CAM namelist - they all begin with "cosp_" to keep their - ! names specific to COSP. I set their CAM namelist defaults here, not in namelist_defaults_cam.xml - ! Variables identified as namelist variables are defined in - ! ../models/atm/cam/bld/namelist_files/namelist_definition.xml + ! Default CAM namelist settings ! ###################################################################################### - ! CAM - logical :: cosp_amwg = .false. ! CAM namelist variable default, not in COSP namelist - logical :: cosp_lite = .false. ! CAM namelist variable default, not in COSP namelist - logical :: cosp_passive = .false. ! CAM namelist variable default, not in COSP namelist - logical :: cosp_active = .false. ! CAM namelist variable default, not in COSP namelist - logical :: cosp_isccp = .false. ! CAM namelist variable default, not in COSP namelist - logical :: cosp_lradar_sim = .false. ! CAM namelist variable default - logical :: cosp_llidar_sim = .false. ! CAM namelist variable default - logical :: cosp_lisccp_sim = .false. ! CAM namelist variable default - logical :: cosp_lmisr_sim = .false. ! CAM namelist variable default - logical :: cosp_lmodis_sim = .false. ! CAM namelist variable default - logical :: cosp_histfile_aux = .false. ! CAM namelist variable default - logical :: cosp_lfrac_out = .false. ! CAM namelist variable default - logical :: cosp_runall = .false. ! flag to run all of the cosp simulator package - integer :: cosp_ncolumns = 50 ! CAM namelist variable default - integer :: cosp_histfile_num =1 ! CAM namelist variable default, not in COSP namelist - integer :: cosp_histfile_aux_num =-1 ! CAM namelist variable default, not in COSP namelist + logical :: cosp_amwg = .false. + logical :: cosp_lite = .false. + logical :: cosp_passive = .false. + logical :: cosp_active = .false. + logical :: cosp_isccp = .false. + logical :: cosp_lradar_sim = .false. + logical :: cosp_llidar_sim = .false. + logical :: cosp_lisccp_sim = .false. + logical :: cosp_lmisr_sim = .false. + logical :: cosp_lmodis_sim = .false. + logical :: cosp_histfile_aux = .false. + logical :: cosp_lfrac_out = .false. + logical :: cosp_runall = .false. + integer :: cosp_ncolumns = 50 + integer :: cosp_histfile_num = 1 + integer :: cosp_histfile_aux_num = -1 ! COSP - logical :: lradar_sim = .false. ! COSP namelist variable, can be changed from default by CAM namelist - logical :: llidar_sim = .false. ! - logical :: lparasol_sim = .false. ! - logical :: lgrLidar532 = .false. ! - logical :: latlid = .false. ! - logical :: lisccp_sim = .false. ! "" - logical :: lmisr_sim = .false. ! "" - logical :: lmodis_sim = .false. ! "" - logical :: lrttov_sim = .false. ! not running rttov, always set to .false. - logical :: lfrac_out = .false. ! COSP namelist variable, can be changed from default by CAM namelist + logical :: lradar_sim = .false. + logical :: llidar_sim = .false. + logical :: lparasol_sim = .false. + logical :: lgrLidar532 = .false. + logical :: latlid = .false. + logical :: lisccp_sim = .false. + logical :: lmisr_sim = .false. + logical :: lmodis_sim = .false. + logical :: lrttov_sim = .false. + logical :: lfrac_out = .false. ! ###################################################################################### ! COSP parameters ! ###################################################################################### - ! Note: Unless otherwise specified, these are parameters that cannot be set by the CAM namelist. integer, parameter :: Npoints_it = 10000 ! Max # gridpoints to be processed in one iteration (10,000) - integer :: ncolumns = 50 ! Number of subcolumns in SCOPS (50), can be changed from default by CAM namelist + integer :: ncolumns = 50 ! Number of subcolumns in SCOPS (50) integer :: nlr = 40 ! Number of levels in statistical outputs ! (only used if USE_VGRID=.true.) (40) logical :: use_vgrid = .true. ! Use fixed vertical grid for outputs? ! (if .true. then define # of levels with nlr) (.true.) logical :: csat_vgrid = .true. ! CloudSat vertical grid? - ! (if .true. then the CloudSat standard grid is used. - ! If set, overides use_vgrid.) (.true.) - ! namelist variables for COSP input related to radar simulator + + ! Variables for COSP input related to radar simulator real(r8) :: radar_freq = 94.0_r8 ! CloudSat radar frequency (GHz) (94.0) integer :: surface_radar = 0 ! surface=1, spaceborne=0 (0) - integer :: use_mie_tables = 0 ! use a precomputed lookup table? yes=1,no=0 (0) integer :: use_gas_abs = 1 ! include gaseous absorption? yes=1,no=0 (1) integer :: do_ray = 0 ! calculate/output Rayleigh refl=1, not=0 (0) - integer :: melt_lay = 0 ! melting layer model off=0, on=1 (0) real(r8) :: k2 = -1 ! |K|^2, -1=use frequency dependent default (-1) - ! namelist variables for COSP input related to lidar simulator + + ! Variables for COSP input related to lidar simulator integer, parameter :: Nprmts_max_hydro = 12 ! Max # params for hydrometeor size distributions (12) integer, parameter :: Naero = 1 ! Number of aerosol species (Not used) (1) integer, parameter :: Nprmts_max_aero = 1 ! Max # params for aerosol size distributions (not used) (1) @@ -185,7 +178,7 @@ module cospsimulator_intr ! (0=ice-spheres ; 1=ice-non-spherical) (0) integer, parameter :: overlap = 3 ! overlap type: 1=max, 2=rand, 3=max/rand (3) - !! namelist variables for COSP input related to ISCCP simulator + ! Variables for COSP input related to ISCCP simulator integer :: isccp_topheight = 1 ! 1 = adjust top height using both a computed infrared ! brightness temperature and the visible ! optical depth to adjust cloud top pressure. @@ -268,188 +261,33 @@ module cospsimulator_intr CONTAINS - ! ###################################################################################### - ! SUBROUTINE setcosp2values - ! ###################################################################################### -#ifdef USE_COSP - subroutine setcosp2values(Nlr_in,use_vgrid_in,csat_vgrid_in,Ncolumns_in,cosp_nradsteps_in) - use mod_cosp, only: cosp_init - use mod_cosp_config, only: vgrid_zl, vgrid_zu, vgrid_z - use mod_quickbeam_optics, only: hydro_class_init, quickbeam_optics_init - ! Inputs - integer, intent(in) :: Nlr_in ! Number of vertical levels for CALIPSO and Cloudsat products - integer, intent(in) :: Ncolumns_in ! Number of sub-columns - integer, intent(in) :: cosp_nradsteps_in ! How often to call COSP? - logical, intent(in) :: use_vgrid_in ! Logical switch to use interpolated, to Nlr_in, grid for CALIPSO and Cloudsat - logical, intent(in) :: csat_vgrid_in ! - - ! Local - logical :: ldouble=.false. - logical :: lsingle=.true. ! Default is to use single moment - integer :: i,k - - prsmid_cosp = pres_binCenters - prslim_cosp = pres_binEdges - taumid_cosp = tau_binCenters - taulim_cosp = tau_binEdges - srmid_cosp = calipso_binCenters - srlim_cosp = calipso_binEdges - sza_cosp = parasol_sza - dbzemid_cosp = cloudsat_binCenters - dbzelim_cosp = cloudsat_binEdges - htmisrmid_cosp = misr_histHgtCenters - htmisrlim_cosp = misr_histHgtEdges - taumid_cosp_modis = tau_binCenters - taulim_cosp_modis = tau_binEdges - reffICE_binCenters_cosp = reffICE_binCenters - reffICE_binEdges_cosp = reffICE_binEdges - reffLIQ_binCenters_cosp = reffLIQ_binCenters - reffLIQ_binEdges_cosp = reffLIQ_binEdges - - ! Initialize the distributional parameters for hydrometeors in radar simulator. In COSPv1.4, this was declared in - ! cosp_defs.f. - if (cloudsat_micro_scheme == 'MMF_v3.5_two_moment') then - ldouble = .true. - lsingle = .false. - endif - call hydro_class_init(lsingle,ldouble,sd) - call quickbeam_optics_init() - - ! DS2017: The setting up of the vertical grid for regridding the CALIPSO and Cloudsat products is - ! now donein cosp_init, but these fields are stored in cosp_config.F90. - ! Additionally all static fields used by the individual simulators are set up by calls - ! to _init functions in cosp_init. - ! DS2019: Add logicals, default=.false., for new Lidar simuldators (Earthcare (atlid) and ground-based - ! lidar at 532nm) - call COSP_INIT(Lisccp_sim, Lmodis_sim, Lmisr_sim, Lradar_sim, Llidar_sim, LgrLidar532, & - Latlid, Lparasol_sim, Lrttov_sim, radar_freq, k2, use_gas_abs, do_ray, & - isccp_topheight, isccp_topheight_direction, surface_radar, rcfg_cloudsat, & - use_vgrid_in, csat_vgrid_in, Nlr_in, pver, cloudsat_micro_scheme) - - ! Set number of sub-columns, from namelist - nscol_cosp = Ncolumns_in - - if (use_vgrid_in) then !! using fixed vertical grid - if (csat_vgrid_in) then - nht_cosp = 40 - else - nht_cosp = Nlr_in - endif - endif - - ! Set COSP call frequency, from namelist. - cosp_nradsteps = cosp_nradsteps_in - - ! DJS2017: In COSP2, most of the bin boundaries, centers, and edges are declared in src/cosp_config.F90. - ! Above I just assign them accordingly in the USE statement. Other bin bounds needed by CAM - ! are calculated here. - ! Allocate - allocate(htlim_cosp(2,nht_cosp),htlim_cosp_1d(nht_cosp+1),htmid_cosp(nht_cosp),scol_cosp(nscol_cosp), & - htdbze_cosp(nht_cosp*CLOUDSAT_DBZE_BINS),htsr_cosp(nht_cosp*nsr_cosp),htmlscol_cosp(nhtml_cosp*nscol_cosp),& - htdbze_htmid_cosp(nht_cosp*CLOUDSAT_DBZE_BINS),htdbze_dbzemid_cosp(nht_cosp*CLOUDSAT_DBZE_BINS), & - htsr_htmid_cosp(nht_cosp*nsr_cosp),htsr_srmid_cosp(nht_cosp*nsr_cosp), & - htmlscol_htmlmid_cosp(nhtml_cosp*nscol_cosp),htmlscol_scol_cosp(nhtml_cosp*nscol_cosp)) - - ! DJS2017: Just pull from cosp_config - if (use_vgrid_in) then - htlim_cosp_1d(1) = vgrid_zu(1) - htlim_cosp_1d(2:nht_cosp+1) = vgrid_zl - endif - htmid_cosp = vgrid_z - htlim_cosp(1,:) = vgrid_zu - htlim_cosp(2,:) = vgrid_zl - - scol_cosp(:) = (/(k,k=1,nscol_cosp)/) - - ! Just using an index here, model height is a prognostic variable - htmlmid_cosp(:) = (/(k,k=1,nhtml_cosp)/) - - ! assign mixed dimensions an integer index for cam_history.F90 - do k=1,nprs_cosp*ntau_cosp - prstau_cosp(k) = k - end do - do k=1,nprs_cosp*ntau_cosp_modis - prstau_cosp_modis(k) = k - end do - do k=1,nht_cosp*CLOUDSAT_DBZE_BINS - htdbze_cosp(k) = k - end do - do k=1,nht_cosp*nsr_cosp - htsr_cosp(k) = k - end do - do k=1,nhtml_cosp*nscol_cosp - htmlscol_cosp(k) = k - end do - do k=1,nhtmisr_cosp*ntau_cosp - htmisrtau_cosp(k) = k - end do - - ! next, assign collapsed reference vectors for cam_history.F90 - ! convention for saving output = prs1,tau1 ... prs1,tau7 ; prs2,tau1 ... prs2,tau7 etc. - ! actual output is specified in cospsimulator1_intr.F90 - do k=1,nprs_cosp - prstau_taumid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=taumid_cosp(1:ntau_cosp) - prstau_prsmid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=prsmid_cosp(k) - prstau_taumid_cosp_modis(ntau_cosp_modis*(k-1)+1:k*ntau_cosp_modis)=taumid_cosp_modis(1:ntau_cosp_modis) - prstau_prsmid_cosp_modis(ntau_cosp_modis*(k-1)+1:k*ntau_cosp_modis)=prsmid_cosp(k) - enddo - - do k=1,nht_cosp - htdbze_dbzemid_cosp(CLOUDSAT_DBZE_BINS*(k-1)+1:k*CLOUDSAT_DBZE_BINS)=dbzemid_cosp(1:CLOUDSAT_DBZE_BINS) - htdbze_htmid_cosp(CLOUDSAT_DBZE_BINS*(k-1)+1:k*CLOUDSAT_DBZE_BINS)=htmid_cosp(k) - enddo - - do k=1,nht_cosp - htsr_srmid_cosp(nsr_cosp*(k-1)+1:k*nsr_cosp)=srmid_cosp(1:nsr_cosp) - htsr_htmid_cosp(nsr_cosp*(k-1)+1:k*nsr_cosp)=htmid_cosp(k) - enddo - - do k=1,nhtml_cosp - htmlscol_scol_cosp(nscol_cosp*(k-1)+1:k*nscol_cosp)=scol_cosp(1:nscol_cosp) - htmlscol_htmlmid_cosp(nscol_cosp*(k-1)+1:k*nscol_cosp)=htmlmid_cosp(k) - enddo - - do k=1,nhtmisr_cosp - htmisrtau_taumid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=taumid_cosp(1:ntau_cosp) - htmisrtau_htmisrmid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=htmisrmid_cosp(k) - enddo - - end subroutine setcosp2values -#endif - ! ###################################################################################### ! SUBROUTINE cospsimulator_intr_readnl - ! - ! PURPOSE: to read namelist variables and run setcospvalues subroutine.note: cldfrc_readnl - ! is a good template in cloud_fraction.F90. Make sure that this routine is reading in a - ! namelist. models/atm/cam/bld/build-namelist is the perl script to check. ! ###################################################################################### subroutine cospsimulator_intr_readnl(nlfile) use namelist_utils, only: find_group_name use units, only: getunit, freeunit #ifdef SPMD - use mpishorthand, only: mpicom, mpilog, mpiint, mpichar + use mpishorthand, only: mpicom, mpilog, mpiint #endif - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input (nlfile=atm_in) + character(len=*), intent(in) :: nlfile ! file containing namelist input (nlfile=atm_in) ! Local variables integer :: unitn, ierr character(len=*), parameter :: subname = 'cospsimulator_intr_readnl' #ifdef USE_COSP -!!! this list should include any variable that you might want to include in the namelist -!!! philosophy is to not include COSP output flags but just important COSP settings and cfmip controls. - namelist /cospsimulator_nl/ docosp, cosp_active, cosp_amwg, & - cosp_histfile_num, cosp_histfile_aux, cosp_histfile_aux_num, cosp_isccp, cosp_lfrac_out, & - cosp_lite, cosp_lradar_sim, cosp_llidar_sim, cosp_lisccp_sim, cosp_lmisr_sim, cosp_lmodis_sim, cosp_ncolumns, & - cosp_nradsteps, cosp_passive, cosp_runall + namelist /cospsimulator_nl/ docosp, cosp_ncolumns, cosp_nradsteps, & + cosp_amwg, cosp_lite, cosp_passive, cosp_active, cosp_isccp, cosp_runall, & + cosp_lfrac_out, cosp_lradar_sim, cosp_llidar_sim, cosp_lisccp_sim, & + cosp_lmisr_sim, cosp_lmodis_sim, & + cosp_histfile_num, cosp_histfile_aux, cosp_histfile_aux_num !! read in the namelist if (masterproc) then unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) !! presumably opens the namelist file "nlfile" - !! position the file to write to the cospsimulator portion of the cam_in namelist + open( unitn, file=trim(nlfile), status='old' ) call find_group_name(unitn, 'cospsimulator_nl', status=ierr) if (ierr == 0) then read(unitn, cospsimulator_nl, iostat=ierr) @@ -565,24 +403,17 @@ subroutine cospsimulator_intr_readnl(nlfile) cosp_nradsteps = 3 end if - !! reset COSP namelist variables based on input from cam namelist variables - if (cosp_ncolumns .ne. ncolumns) then - ncolumns = cosp_ncolumns - end if + ! Set number of sub-columns, from namelist + ncolumns = cosp_ncolumns + nscol_cosp = cosp_ncolumns - ! *NOTE* COSP is configured in CAM such that if a simulator is requested, all diagnostics - ! are output. So no need turn on/aff outputs if simulator is requested. - - ! Set vertical coordinate, subcolumn, and calculation frequency cosp options based on namelist inputs - call setcosp2values(nlr,use_vgrid,csat_vgrid,ncolumns,cosp_nradsteps) - if (masterproc) then if (docosp) then write(iulog,*)'COSP configuration:' write(iulog,*)' Number of COSP subcolumns = ', cosp_ncolumns - write(iulog,*)' Frequency at which cosp is called = ', cosp_nradsteps + write(iulog,*)' COSP frequency in radiation steps = ', cosp_nradsteps write(iulog,*)' Enable radar simulator = ', lradar_sim - write(iulog,*)' Enable calipso simulator = ', llidar_sim + write(iulog,*)' Enable calipso simulator = ', llidar_sim write(iulog,*)' Enable ISCCP simulator = ', lisccp_sim write(iulog,*)' Enable MISR simulator = ', lmisr_sim write(iulog,*)' Enable MODIS simulator = ', lmodis_sim @@ -590,7 +421,7 @@ subroutine cospsimulator_intr_readnl(nlfile) write(iulog,*)' Write COSP output to history file = ', cosp_histfile_num write(iulog,*)' Write COSP input fields = ', cosp_histfile_aux write(iulog,*)' Write COSP input fields to history file = ', cosp_histfile_aux_num - write(iulog,*)' Write COSP subcolumn fields = ', cosp_lfrac_out + write(iulog,*)' Write COSP subcolumn fields = ', lfrac_out else write(iulog,*)'COSP not enabled' end if @@ -603,10 +434,23 @@ end subroutine cospsimulator_intr_readnl ! ###################################################################################### subroutine cospsimulator_intr_register() + ! The coordinate variables used for COSP output are defined here. This + ! needs to be done before the call to read_restart_history in order for + ! restarts to work. + use cam_history_support, only: add_hist_coord + !--------------------------------------------------------------------------- #ifdef USE_COSP - ! register non-standard variable dimensions + ! Set number of levels used by COSP to the number of levels used by + ! CAM's cloud macro/microphysics parameterizations. + nlay = pver - ktop + 1 + nlayp = nlay + 1 + + ! Set COSP coordinate arrays + call setcosp2values() + + ! Define coordinate variables for COSP outputs. if (lisccp_sim .or. lmodis_sim) then call add_hist_coord('cosp_prs', nprs_cosp, 'COSP Mean ISCCP pressure', & 'hPa', prsmid_cosp, bounds_name='cosp_prs_bnds', bounds=prslim_cosp) @@ -625,7 +469,7 @@ subroutine cospsimulator_intr_register() if (llidar_sim .or. lradar_sim) then call add_hist_coord('cosp_ht', nht_cosp, & - 'COSP Mean Height for calipso and radar simulator outputs', 'm', & + 'COSP Mean Height for calipso and radar simulator outputs', 'm', & htmid_cosp, bounds_name='cosp_ht_bnds', bounds=htlim_cosp, & vertical_coord=.true.) end if @@ -642,7 +486,7 @@ subroutine cospsimulator_intr_register() end if if (lradar_sim) then - call add_hist_coord('cosp_dbze', CLOUDSAT_DBZE_BINS, & + call add_hist_coord('cosp_dbze', CLOUDSAT_DBZE_BINS, & 'COSP Mean dBZe for radar simulator CFAD output', 'dBZ', & dbzemid_cosp, bounds_name='cosp_dbze_bnds', bounds=dbzelim_cosp) end if @@ -676,482 +520,346 @@ subroutine cospsimulator_intr_init() #ifdef USE_COSP use cam_history, only: addfld, add_default, horiz_only -#ifdef SPMD - use mpishorthand, only : mpir8, mpiint, mpicom -#endif - use netcdf, only : nf90_open, nf90_inq_varid, nf90_get_var, nf90_close, nf90_nowrite - use error_messages, only : handle_ncerr, alloc_err - - use physics_buffer, only: pbuf_get_index + use physics_buffer, only: pbuf_get_index - use mod_cosp_config, only : R_UNDEF - - integer :: ncid,latid,lonid,did,hrid,minid,secid, istat - integer :: i, ierr + integer :: i, ierr, istat + character(len=*), parameter :: sub = 'cospsimulator_intr_init' + !--------------------------------------------------------------------------- + ! The COSP init method (setcosp2values) was run from cospsimulator_intr_register in order to add + ! the history coordinate variables earlier as needed for the restart time sequencing. + ! ISCCP OUTPUTS if (lisccp_sim) then - !! addfld calls for all - !*cfMon,cfDa* clisccp2 (time,tau,plev,profile), CFMIP wants 7 p bins, 7 tau bins - call addfld('FISCCP1_COSP',(/'cosp_tau','cosp_prs'/),'A','percent', & - 'Grid-box fraction covered by each ISCCP D level cloud type',& - flag_xyfill=.true., fill_value=R_UNDEF) - - !*cfMon,cfDa* tclisccp (time,profile), CFMIP wants "gridbox mean cloud cover from ISCCP" - call addfld('CLDTOT_ISCCP', horiz_only,'A','percent', & + call addfld('FISCCP1_COSP', (/'cosp_tau','cosp_prs'/), 'A', 'percent', & + 'Grid-box fraction covered by each ISCCP D level cloud type', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTOT_ISCCP', horiz_only, 'A', 'percent', & 'Total Cloud Fraction Calculated by the ISCCP Simulator ',flag_xyfill=.true., fill_value=R_UNDEF) - !*cfMon,cfDa* albisccp (time,profile) - ! Per CFMIP request - weight by ISCCP Total Cloud Fraction (divide by CLDTOT_ISSCP in history file to get weighted average) - call addfld('MEANCLDALB_ISCCP',horiz_only,'A','1','Mean cloud albedo*CLDTOT_ISCCP',flag_xyfill=.true., fill_value=R_UNDEF) - !*cfMon,cfDa* ctpisccp (time,profile) - ! Per CFMIP request - weight by ISCCP Total Cloud Fraction (divide by CLDTOT_ISSCP in history file to get weighted average) - call addfld('MEANPTOP_ISCCP',horiz_only,'A','Pa','Mean cloud top pressure*CLDTOT_ISCCP',flag_xyfill=.true., & - fill_value=R_UNDEF) - ! tauisccp (time,profile) - ! For averaging, weight by ISCCP Total Cloud Fraction (divide by CLDTOT_ISSCP in history file to get weighted average) - call addfld ('MEANTAU_ISCCP',horiz_only,'A','1','Mean optical thickness*CLDTOT_ISCCP',flag_xyfill=.true., & - fill_value=R_UNDEF) - ! meantbisccp (time,profile), at 10.5 um - call addfld ('MEANTB_ISCCP',horiz_only,'A','K','Mean Infrared Tb from ISCCP simulator',flag_xyfill=.true., & - fill_value=R_UNDEF) - ! meantbclrisccp (time,profile) - call addfld ('MEANTBCLR_ISCCP',horiz_only,'A','K','Mean Clear-sky Infrared Tb from ISCCP simulator', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! boxtauisccp (time,column,profile) - call addfld ('TAU_ISCCP',(/'cosp_scol'/),'I','1','Optical Depth in each Subcolumn',flag_xyfill=.true., fill_value=R_UNDEF) - ! boxptopisccp (time,column,profile) - call addfld ('CLDPTOP_ISCCP',(/'cosp_scol'/),'I','Pa','Cloud Top Pressure in each Subcolumn', & - flag_xyfill=.true., fill_value=R_UNDEF) - - !! add all isccp outputs to the history file specified by the CAM namelist variable cosp_histfile_num - call add_default ('FISCCP1_COSP',cosp_histfile_num,' ') - call add_default ('CLDTOT_ISCCP',cosp_histfile_num,' ') - call add_default ('MEANCLDALB_ISCCP',cosp_histfile_num,' ') - call add_default ('MEANPTOP_ISCCP',cosp_histfile_num,' ') - call add_default ('MEANTAU_ISCCP',cosp_histfile_num,' ') - call add_default ('MEANTB_ISCCP',cosp_histfile_num,' ') - call add_default ('MEANTBCLR_ISCCP',cosp_histfile_num,' ') + call addfld('MEANCLDALB_ISCCP', horiz_only, 'A', '1', & + 'Mean cloud albedo*CLDTOT_ISCCP', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('MEANPTOP_ISCCP', horiz_only, 'A', 'Pa', & + 'Mean cloud top pressure*CLDTOT_ISCCP',flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('MEANTAU_ISCCP', horiz_only, 'A', '1', & + 'Mean optical thickness*CLDTOT_ISCCP',flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('MEANTB_ISCCP', horiz_only, 'A', 'K', & + 'Mean Infrared Tb from ISCCP simulator',flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('MEANTBCLR_ISCCP', horiz_only, 'A', 'K', & + 'Mean Clear-sky Infrared Tb from ISCCP simulator', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('TAU_ISCCP', (/'cosp_scol'/), 'I', '1', & + 'Optical Depth in each Subcolumn', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDPTOP_ISCCP', (/'cosp_scol'/), 'I', 'Pa', & + 'Cloud Top Pressure in each Subcolumn', flag_xyfill=.true., fill_value=R_UNDEF) + + call add_default('FISCCP1_COSP',cosp_histfile_num,' ') + call add_default('CLDTOT_ISCCP',cosp_histfile_num,' ') + call add_default('MEANCLDALB_ISCCP',cosp_histfile_num,' ') + call add_default('MEANPTOP_ISCCP',cosp_histfile_num,' ') + call add_default('MEANTAU_ISCCP',cosp_histfile_num,' ') + call add_default('MEANTB_ISCCP',cosp_histfile_num,' ') + call add_default('MEANTBCLR_ISCCP',cosp_histfile_num,' ') end if ! CALIPSO SIMULATOR OUTPUTS if (llidar_sim) then - !! addfld calls for all - !*cfMon,cfOff,cfDa,cf3hr* cllcalipso (time,profile) - call addfld('CLDLOW_CAL',horiz_only,'A','percent','Calipso Low-level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - !*cfMon,cfOff,cfDa,cf3hr* clmcalipso (time,profile) - call addfld('CLDMED_CAL',horiz_only,'A','percent','Calipso Mid-level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - !*cfMon,cfOff,cfDa,cf3hr* clhcalipso (time,profile) - call addfld('CLDHGH_CAL',horiz_only,'A','percent','Calipso High-level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - !*cfMon,cfOff,cfDa,cf3hr* cltcalipso (time,profile) - call addfld('CLDTOT_CAL',horiz_only,'A','percent','Calipso Total Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - !*cfMon,cfOff,cfDa,cf3hr* clcalipso (time,height,profile) - call addfld('CLD_CAL',(/'cosp_ht'/),'A','percent','Calipso Cloud Fraction (532 nm)', flag_xyfill=.true., fill_value=R_UNDEF) - !*cfMon,cfOff,cfDa,cf3hr* parasol_refl (time,sza,profile) - call addfld ('RFL_PARASOL',(/'cosp_sza'/),'A','fraction','PARASOL-like mono-directional reflectance ', & - flag_xyfill=.true., fill_value=R_UNDEF) - !*cfOff,cf3hr* cfad_calipsosr532 (time,height,scat_ratio,profile), %11%, default is 40 vert levs, 15 SR bins - call addfld('CFAD_SR532_CAL',(/'cosp_sr','cosp_ht'/),'A','fraction', & - 'Calipso Scattering Ratio CFAD (532 nm)', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! beta_mol532 (time,height_mlev,profile) - call addfld ('MOL532_CAL',(/'lev'/),'A','m-1sr-1','Calipso Molecular Backscatter (532 nm) ', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! atb532 (time,height_mlev,column,profile) - call addfld ('ATB532_CAL',(/'cosp_scol','lev '/),'I','no_unit_log10(x)', & - 'Calipso Attenuated Total Backscatter (532 nm) in each Subcolumn', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclcalipsoliq (time,alt40,loc) !!+cosp1.4 - call addfld('CLD_CAL_LIQ', (/'cosp_ht'/), 'A','percent', 'Calipso Liquid Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclcalipsoice (time,alt40,loc) - call addfld('CLD_CAL_ICE', (/'cosp_ht'/), 'A','percent', 'Calipso Ice Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclcalipsoun (time,alt40,loc) - call addfld('CLD_CAL_UN', (/'cosp_ht'/),'A','percent', 'Calipso Undefined-Phase Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclcalipsotmp (time,alt40,loc) - call addfld('CLD_CAL_TMP', (/'cosp_ht'/), 'A','percent', 'NOT SURE WHAT THIS IS Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclcalipsotmpliq (time,alt40,loc) - call addfld('CLD_CAL_TMPLIQ', (/'cosp_ht'/), 'A','percent', 'NOT SURE WHAT THIS IS Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclcalipsotmpice (time,alt40,loc) - call addfld('CLD_CAL_TMPICE', (/'cosp_ht'/), 'A','percent', 'NOT SURE WHAT THIS IS Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclcalipsotmpun (time,alt40,loc) - call addfld('CLD_CAL_TMPUN', (/'cosp_ht'/), 'A','percent', 'NOT SURE WHAT THIS IS Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lcltcalipsoice (time,loc) - call addfld('CLDTOT_CAL_ICE', horiz_only,'A','percent','Calipso Total Ice Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lcltcalipsoliq (time,loc) - call addfld('CLDTOT_CAL_LIQ', horiz_only,'A','percent','Calipso Total Liquid Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lcltcalipsoun (time,loc) - call addfld('CLDTOT_CAL_UN',horiz_only,'A','percent','Calipso Total Undefined-Phase Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclhcalipsoice (time,loc) - call addfld('CLDHGH_CAL_ICE',horiz_only,'A','percent','Calipso High-level Ice Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclhcalipsoliq (time,loc) - call addfld('CLDHGH_CAL_LIQ',horiz_only,'A','percent','Calipso High-level Liquid Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclhcalipsoun (time,loc) - call addfld('CLDHGH_CAL_UN',horiz_only,'A','percent','Calipso High-level Undefined-Phase Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclmcalipsoice (time,loc) - call addfld('CLDMED_CAL_ICE',horiz_only,'A','percent','Calipso Mid-level Ice Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclmcalipsoliq (time,loc) - call addfld('CLDMED_CAL_LIQ',horiz_only,'A','percent','Calipso Mid-level Liquid Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclmcalipsoun (time,loc) - call addfld('CLDMED_CAL_UN',horiz_only,'A','percent','Calipso Mid-level Undefined-Phase Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lcllcalipsoice (time,loc) - call addfld('CLDLOW_CAL_ICE',horiz_only,'A','percent','Calipso Low-level Ice Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lcllcalipsoliq (time,loc) - call addfld('CLDLOW_CAL_LIQ',horiz_only,'A','percent','Calipso Low-level Liquid Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lcllcalipsoun (time,loc) !+cosp1.4 - call addfld('CLDLOW_CAL_UN',horiz_only,'A','percent','Calipso Low-level Undefined-Phase Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - -! ! Calipso Opaque/thin cloud diagnostics -! call addfld('CLDOPQ_CAL', horiz_only, 'A', 'percent', 'CALIPSO Opaque Cloud Cover', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDTHN_CAL', horiz_only, 'A', 'percent', 'CALIPSO Thin Cloud Cover', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDZOPQ_CAL', horiz_only, 'A', 'm', 'CALIPSO z_opaque Altitude', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDOPQ_CAL_2D', (/'cosp_ht'/), 'A', 'percent', 'CALIPSO Opaque Cloud Fraction', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDTHN_CAL_2D', (/'cosp_ht'/), 'A', 'percent', 'CALIPSO Thin Cloud Fraction', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDZOPQ_CAL_2D', (/'cosp_ht'/), 'A', 'percent', 'CALIPSO z_opaque Fraction', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('OPACITY_CAL_2D', (/'cosp_ht'/), 'A', 'percent', 'CALIPSO opacity Fraction', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDOPQ_CAL_TMP', horiz_only, 'A', 'K', 'CALIPSO Opaque Cloud Temperature', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDTHN_CAL_TMP', horiz_only, 'A', 'K', 'CALIPSO Thin Cloud Temperature', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDZOPQ_CAL_TMP', horiz_only, 'A', 'K', 'CALIPSO z_opaque Temperature', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDOPQ_CAL_Z', horiz_only, 'A', 'm', 'CALIPSO Opaque Cloud Altitude', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDTHN_CAL_Z', horiz_only, 'A', 'm', 'CALIPSO Thin Cloud Altitude', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDTHN_CAL_EMIS', horiz_only, 'A', '1', 'CALIPSO Thin Cloud Emissivity', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDOPQ_CAL_SE', horiz_only, 'A', 'm', 'CALIPSO Opaque Cloud Altitude with respect to surface-elevation', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDTHN_CAL_SE', horiz_only, 'A', 'm', 'CALIPSO Thin Cloud Altitude with respect to surface-elevation', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDZOPQ_CAL_SE', horiz_only, 'A', 'm', 'CALIPSO z_opaque Altitude with respect to surface-elevation', & -! flag_xyfill=.true., fill_value=R_UNDEF) - - ! add_default calls for CFMIP experiments or else all fields are added to history file - ! except those with sub-column dimension/experimental variables - !! add all calipso outputs to the history file specified by the CAM namelist variable cosp_histfile_num - call add_default ('CLDLOW_CAL',cosp_histfile_num,' ') - call add_default ('CLDMED_CAL',cosp_histfile_num,' ') - call add_default ('CLDHGH_CAL',cosp_histfile_num,' ') - call add_default ('CLDTOT_CAL',cosp_histfile_num,' ') - call add_default ('CLD_CAL',cosp_histfile_num,' ') - call add_default ('RFL_PARASOL',cosp_histfile_num,' ') - call add_default ('CFAD_SR532_CAL',cosp_histfile_num,' ') - call add_default ('CLD_CAL_LIQ',cosp_histfile_num,' ') !+COSP1.4 - call add_default ('CLD_CAL_ICE',cosp_histfile_num,' ') - call add_default ('CLD_CAL_UN',cosp_histfile_num,' ') - call add_default ('CLDTOT_CAL_ICE',cosp_histfile_num,' ') - call add_default ('CLDTOT_CAL_LIQ',cosp_histfile_num,' ') - call add_default ('CLDTOT_CAL_UN',cosp_histfile_num,' ') - call add_default ('CLDHGH_CAL_ICE',cosp_histfile_num,' ') - call add_default ('CLDHGH_CAL_LIQ',cosp_histfile_num,' ') - call add_default ('CLDHGH_CAL_UN',cosp_histfile_num,' ') - call add_default ('CLDMED_CAL_ICE',cosp_histfile_num,' ') - call add_default ('CLDMED_CAL_LIQ',cosp_histfile_num,' ') - call add_default ('CLDMED_CAL_UN',cosp_histfile_num,' ') - call add_default ('CLDLOW_CAL_ICE',cosp_histfile_num,' ') - call add_default ('CLDLOW_CAL_LIQ',cosp_histfile_num,' ') - call add_default ('CLDLOW_CAL_UN',cosp_histfile_num,' ') -! call add_default ('CLDOPQ_CAL',cosp_histfile_num,' ') -! call add_default ('CLDTHN_CAL',cosp_histfile_num,' ') -! call add_default ('CLDZOPQ_CAL',cosp_histfile_num,' ') -! call add_default ('CLDOPQ_CAL_2D',cosp_histfile_num,' ') -! call add_default ('CLDTHN_CAL_2D',cosp_histfile_num,' ') -! call add_default ('CLDZOPQ_CAL_2D',cosp_histfile_num,' ') -! call add_default ('OPACITY_CAL_2D',cosp_histfile_num,' ') -! call add_default ('CLDOPQ_CAL_TMP',cosp_histfile_num,' ') -! call add_default ('CLDTHN_CAL_TMP',cosp_histfile_num,' ') -! call add_default ('CLDZOPQ_CAL_TMP',cosp_histfile_num,' ') -! call add_default ('CLDOPQ_CAL_Z',cosp_histfile_num,' ') -! call add_default ('CLDTHN_CAL_Z',cosp_histfile_num,' ') -! call add_default ('CLDTHN_CAL_EMIS',cosp_histfile_num,' ') -! call add_default ('CLDOPQ_CAL_SE',cosp_histfile_num,' ') -! call add_default ('CLDTHN_CAL_SE',cosp_histfile_num,' ') -! call add_default ('CLDZOPQ_CAL_SE',cosp_histfile_num,' ') + call addfld('CLDLOW_CAL', horiz_only, 'A', 'percent', & + 'Calipso Low-level Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDMED_CAL', horiz_only, 'A', 'percent', & + 'Calipso Mid-level Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDHGH_CAL', horiz_only, 'A', 'percent', & + 'Calipso High-level Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTOT_CAL', horiz_only, 'A', 'percent', & + 'Calipso Total Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLD_CAL', (/'cosp_ht'/), 'A', 'percent', & + 'Calipso Cloud Fraction (532 nm)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('RFL_PARASOL', (/'cosp_sza'/), 'A', 'fraction', & + 'PARASOL-like mono-directional reflectance ', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CFAD_SR532_CAL', (/'cosp_sr','cosp_ht'/), 'A', 'fraction', & + 'Calipso Scattering Ratio CFAD (532 nm)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('MOL532_CAL', (/'trop_pref'/), 'A', 'm-1 sr-1', & + 'Calipso Molecular Backscatter (532 nm) ', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('ATB532_CAL', (/'cosp_scol','trop_pref'/), 'I', 'no_unit_log10(x)', & + 'Calipso Attenuated Total Backscatter (532 nm) in each Subcolumn', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLD_CAL_LIQ', (/'cosp_ht'/), 'A', 'percent', & + 'Calipso Liquid Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLD_CAL_ICE', (/'cosp_ht'/), 'A', 'percent', & + 'Calipso Ice Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLD_CAL_UN', (/'cosp_ht'/), 'A', 'percent', & + 'Calipso Undefined-Phase Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLD_CAL_TMP', (/'cosp_ht'/), 'A', 'K', & + 'Calipso Cloud Temperature', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLD_CAL_TMPLIQ', (/'cosp_ht'/), 'A', 'K', & + 'Calipso Liquid Cloud Temperature', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLD_CAL_TMPICE', (/'cosp_ht'/), 'A', 'K', & + 'Calipso Ice Cloud Temperature', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLD_CAL_TMPUN', (/'cosp_ht'/), 'A', 'K', & + 'Calipso Undefined-Phase Cloud Temperature', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTOT_CAL_ICE', horiz_only, 'A', 'percent', & + 'Calipso Total Ice Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTOT_CAL_LIQ', horiz_only, 'A', 'percent', & + 'Calipso Total Liquid Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTOT_CAL_UN', horiz_only, 'A', 'percent', & + 'Calipso Total Undefined-Phase Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDHGH_CAL_ICE', horiz_only, 'A', 'percent', & + 'Calipso High-level Ice Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDHGH_CAL_LIQ', horiz_only, 'A', 'percent', & + 'Calipso High-level Liquid Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDHGH_CAL_UN', horiz_only, 'A', 'percent', & + 'Calipso High-level Undefined-Phase Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDMED_CAL_ICE', horiz_only, 'A', 'percent', & + 'Calipso Mid-level Ice Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDMED_CAL_LIQ', horiz_only, 'A', 'percent', & + 'Calipso Mid-level Liquid Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDMED_CAL_UN', horiz_only, 'A', 'percent', & + 'Calipso Mid-level Undefined-Phase Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDLOW_CAL_ICE', horiz_only, 'A', 'percent', & + 'Calipso Low-level Ice Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDLOW_CAL_LIQ', horiz_only, 'A', 'percent', & + 'Calipso Low-level Liquid Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDLOW_CAL_UN', horiz_only, 'A', 'percent', & + 'Calipso Low-level Undefined-Phase Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + + call add_default('CLDLOW_CAL',cosp_histfile_num,' ') + call add_default('CLDMED_CAL',cosp_histfile_num,' ') + call add_default('CLDHGH_CAL',cosp_histfile_num,' ') + call add_default('CLDTOT_CAL',cosp_histfile_num,' ') + call add_default('CLD_CAL',cosp_histfile_num,' ') + call add_default('RFL_PARASOL',cosp_histfile_num,' ') + call add_default('CFAD_SR532_CAL',cosp_histfile_num,' ') + call add_default('CLD_CAL_LIQ',cosp_histfile_num,' ') + call add_default('CLD_CAL_ICE',cosp_histfile_num,' ') + call add_default('CLD_CAL_UN',cosp_histfile_num,' ') + call add_default('CLDTOT_CAL_ICE',cosp_histfile_num,' ') + call add_default('CLDTOT_CAL_LIQ',cosp_histfile_num,' ') + call add_default('CLDTOT_CAL_UN',cosp_histfile_num,' ') + call add_default('CLDHGH_CAL_ICE',cosp_histfile_num,' ') + call add_default('CLDHGH_CAL_LIQ',cosp_histfile_num,' ') + call add_default('CLDHGH_CAL_UN',cosp_histfile_num,' ') + call add_default('CLDMED_CAL_ICE',cosp_histfile_num,' ') + call add_default('CLDMED_CAL_LIQ',cosp_histfile_num,' ') + call add_default('CLDMED_CAL_UN',cosp_histfile_num,' ') + call add_default('CLDLOW_CAL_ICE',cosp_histfile_num,' ') + call add_default('CLDLOW_CAL_LIQ',cosp_histfile_num,' ') + call add_default('CLDLOW_CAL_UN',cosp_histfile_num,' ') if ((.not.cosp_amwg) .and. (.not.cosp_lite) .and. (.not.cosp_passive) .and. (.not.cosp_active) & .and. (.not.cosp_isccp)) then - call add_default ('MOL532_CAL',cosp_histfile_num,' ') + call add_default('MOL532_CAL',cosp_histfile_num,' ') end if end if ! RADAR SIMULATOR OUTPUTS + allocate(sd_cs(begchunk:endchunk), rcfg_cs(begchunk:endchunk), stat=istat) + call handle_allocate_error(istat, sub, 'sd_cs,rcfg_cs') if (lradar_sim) then - allocate(sd_cs(begchunk:endchunk), rcfg_cs(begchunk:endchunk)) do i = begchunk, endchunk sd_cs(i) = sd rcfg_cs(i) = rcfg_cloudsat end do - ! addfld calls - !*cfOff,cf3hr* cfad_dbze94 (time,height,dbze,profile), default is 40 vert levs, 15 dBZ bins - call addfld('CFAD_DBZE94_CS',(/'cosp_dbze','cosp_ht '/),'A','fraction',& - 'Radar Reflectivity Factor CFAD (94 GHz)',& - flag_xyfill=.true., fill_value=R_UNDEF) - !*cfOff,cf3hr* clcalipso2 (time,height,profile) - call addfld ('CLD_CAL_NOTCS',(/'cosp_ht'/),'A','percent','Cloud occurrence seen by CALIPSO but not CloudSat ', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! cltcalipsoradar (time,profile) - call addfld ('CLDTOT_CALCS',horiz_only,'A','percent',' Calipso and Radar Total Cloud Fraction ',flag_xyfill=.true., & - fill_value=R_UNDEF) - call addfld ('CLDTOT_CS',horiz_only,'A','percent',' Radar total cloud amount ',flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('CLDTOT_CS2',horiz_only,'A','percent', & - ' Radar total cloud amount without the data for the first kilometer above surface ', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! dbze94 (time,height_mlev,column,profile),! height_mlevel = height when vgrid_in = .true. (default) - call addfld ('DBZE_CS',(/'cosp_scol','lev '/),'I','dBZe',' Radar dBZe (94 GHz) in each Subcolumn',& + call addfld('CFAD_DBZE94_CS',(/'cosp_dbze','cosp_ht '/), 'A', 'fraction', & + 'Radar Reflectivity Factor CFAD (94 GHz)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLD_CAL_NOTCS', (/'cosp_ht'/), 'A', 'percent', & + 'Cloud occurrence seen by CALIPSO but not CloudSat ', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTOT_CALCS', horiz_only, 'A', 'percent', & + 'Calipso and Radar Total Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTOT_CS', horiz_only, 'A', 'percent', & + 'Radar total cloud amount', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTOT_CS2', horiz_only, 'A', 'percent', & + 'Radar total cloud amount without the data for the first kilometer above surface ', & flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('DBZE_CS', (/'cosp_scol','trop_pref'/), 'I', 'dBZe', & + 'Radar dBZe (94 GHz) in each Subcolumn', flag_xyfill=.true., fill_value=R_UNDEF) ! Cloudsat near-sfc precipitation diagnostics - call addfld('CS_NOPRECIP', horiz_only, 'A', '1', 'CloudSat No Rain Fraction', flag_xyfill=.true., fill_value=R_UNDEF) - call addfld('CS_RAINPOSS', horiz_only, 'A', '1', 'Cloudsat Rain Possible Fraction', flag_xyfill=.true., fill_value=R_UNDEF) - call addfld('CS_RAINPROB', horiz_only, 'A', '1', 'CloudSat Rain Probable Fraction', flag_xyfill=.true., fill_value=R_UNDEF) - call addfld('CS_RAINCERT', horiz_only, 'A', '1', 'CloudSat Rain Certain Fraction', flag_xyfill=.true., fill_value=R_UNDEF) - call addfld('CS_SNOWPOSS', horiz_only, 'A', '1', 'CloudSat Snow Possible Fraction', flag_xyfill=.true., fill_value=R_UNDEF) - call addfld('CS_SNOWCERT', horiz_only, 'A', '1', 'CloudSat Snow Certain Fraction', flag_xyfill=.true., fill_value=R_UNDEF) - call addfld('CS_MIXPOSS', horiz_only, 'A', '1', 'CloudSat Mixed Possible Fraction', flag_xyfill=.true., fill_value=R_UNDEF) - call addfld('CS_MIXCERT', horiz_only, 'A', '1', 'CloudSat Mixed Certain Fraction', flag_xyfill=.true., fill_value=R_UNDEF) - call addfld('CS_RAINHARD', horiz_only, 'A', '1', 'CloudSat Heavy Rain Fraction', flag_xyfill=.true., fill_value=R_UNDEF) - call addfld('CS_UN', horiz_only, 'A', '1', 'CloudSat Unclassified Precipitation Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - call addfld('CS_PIA', horiz_only, 'A', 'dBZ', 'CloudSat Radar Path Integrated Attenuation', flag_xyfill=.true., fill_value=R_UNDEF) - ! Associated CAM microphysics - !call addfld('CAM_MP_CVRAIN',horiz_only, 'A', 'kg/kg','CAM Microphysics Convective Rain', flag_xyfill=.true., fill_value=R_UNDEF) - !call addfld('CAM_MP_CVSNOW',horiz_only, 'A', 'kg/kg','CAM Microphysics Convective Snow', flag_xyfill=.true., fill_value=R_UNDEF) - !call addfld('CAM_MP_LSRAIN',horiz_only, 'A', 'kg/kg','CAM Microphysics Large-Scale Rain', flag_xyfill=.true., fill_value=R_UNDEF) - !call addfld('CAM_MP_LSSNOW',horiz_only, 'A', 'kg/kg','CAM Microphysics Large-Scale Snow', flag_xyfill=.true., fill_value=R_UNDEF) - !call addfld('CAM_MP_LSGRPL',horiz_only, 'A', 'kg/kg','CAM Microphysics Large-Scale Graupel', flag_xyfill=.true., fill_value=R_UNDEF) - - - ! add_default calls for CFMIP experiments or else all fields are added to history file except those with sub-column dimension - !! add all radar outputs to the history file specified by the CAM namelist variable cosp_histfile_num - call add_default ('CFAD_DBZE94_CS',cosp_histfile_num,' ') - call add_default ('CLD_CAL_NOTCS', cosp_histfile_num,' ') - call add_default ('CLDTOT_CALCS', cosp_histfile_num,' ') - call add_default ('CLDTOT_CS', cosp_histfile_num,' ') - call add_default ('CLDTOT_CS2', cosp_histfile_num,' ') - call add_default ('CS_NOPRECIP', cosp_histfile_num,' ') - call add_default ('CS_RAINPOSS', cosp_histfile_num,' ') - call add_default ('CS_RAINPROB', cosp_histfile_num,' ') - call add_default ('CS_RAINCERT', cosp_histfile_num,' ') - call add_default ('CS_SNOWPOSS', cosp_histfile_num,' ') - call add_default ('CS_SNOWCERT', cosp_histfile_num,' ') - call add_default ('CS_MIXPOSS', cosp_histfile_num,' ') - call add_default ('CS_MIXCERT', cosp_histfile_num,' ') - call add_default ('CS_RAINHARD', cosp_histfile_num,' ') - call add_default ('CS_UN', cosp_histfile_num,' ') - call add_default ('CS_PIA', cosp_histfile_num,' ') + call addfld('CS_NOPRECIP', horiz_only, 'A', '1', & + 'CloudSat No Rain Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CS_RAINPOSS', horiz_only, 'A', '1', & + 'Cloudsat Rain Possible Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CS_RAINPROB', horiz_only, 'A', '1', & + 'CloudSat Rain Probable Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CS_RAINCERT', horiz_only, 'A', '1', & + 'CloudSat Rain Certain Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CS_SNOWPOSS', horiz_only, 'A', '1', & + 'CloudSat Snow Possible Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CS_SNOWCERT', horiz_only, 'A', '1', & + 'CloudSat Snow Certain Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CS_MIXPOSS', horiz_only, 'A', '1', & + 'CloudSat Mixed Possible Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CS_MIXCERT', horiz_only, 'A', '1', & + 'CloudSat Mixed Certain Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CS_RAINHARD', horiz_only, 'A', '1', & + 'CloudSat Heavy Rain Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CS_UN', horiz_only, 'A', '1', & + 'CloudSat Unclassified Precipitation Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CS_PIA', horiz_only, 'A', 'dBZ', & + 'CloudSat Radar Path Integrated Attenuation', flag_xyfill=.true., fill_value=R_UNDEF) + + call add_default('CFAD_DBZE94_CS',cosp_histfile_num,' ') + call add_default('CLD_CAL_NOTCS', cosp_histfile_num,' ') + call add_default('CLDTOT_CALCS', cosp_histfile_num,' ') + call add_default('CLDTOT_CS', cosp_histfile_num,' ') + call add_default('CLDTOT_CS2', cosp_histfile_num,' ') + call add_default('CS_NOPRECIP', cosp_histfile_num,' ') + call add_default('CS_RAINPOSS', cosp_histfile_num,' ') + call add_default('CS_RAINPROB', cosp_histfile_num,' ') + call add_default('CS_RAINCERT', cosp_histfile_num,' ') + call add_default('CS_SNOWPOSS', cosp_histfile_num,' ') + call add_default('CS_SNOWCERT', cosp_histfile_num,' ') + call add_default('CS_MIXPOSS', cosp_histfile_num,' ') + call add_default('CS_MIXCERT', cosp_histfile_num,' ') + call add_default('CS_RAINHARD', cosp_histfile_num,' ') + call add_default('CS_UN', cosp_histfile_num,' ') + call add_default('CS_PIA', cosp_histfile_num,' ') end if ! MISR SIMULATOR OUTPUTS if (lmisr_sim) then - ! clMISR (time,tau,CTH_height_bin,profile) - call addfld ('CLD_MISR',(/'cosp_tau ','cosp_htmisr'/),'A','percent','Cloud Fraction from MISR Simulator', & - flag_xyfill=.true., fill_value=R_UNDEF) - !! add all misr outputs to the history file specified by the CAM namelist variable cosp_histfile_num - call add_default ('CLD_MISR',cosp_histfile_num,' ') + call addfld('CLD_MISR', (/'cosp_tau ','cosp_htmisr'/), 'A', 'percent', & + 'Cloud Fraction from MISR Simulator', flag_xyfill=.true., fill_value=R_UNDEF) + + call add_default('CLD_MISR',cosp_histfile_num,' ') end if ! MODIS OUTPUT if (lmodis_sim) then - ! float cltmodis ( time, loc ) - call addfld ('CLTMODIS',horiz_only,'A','%','MODIS Total Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - ! float clwmodis ( time, loc ) - call addfld ('CLWMODIS',horiz_only,'A','%','MODIS Liquid Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - ! float climodis ( time, loc ) - call addfld ('CLIMODIS',horiz_only,'A','%','MODIS Ice Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - ! float clhmodis ( time, loc ) - call addfld ('CLHMODIS',horiz_only,'A','%','MODIS High Level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - ! float clmmodis ( time, loc ) - call addfld ('CLMMODIS',horiz_only,'A','%','MODIS Mid Level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - ! float cllmodis ( time, loc ) - call addfld ('CLLMODIS',horiz_only,'A','%','MODIS Low Level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - ! float tautmodis ( time, loc ) - call addfld ('TAUTMODIS',horiz_only,'A','1','MODIS Total Cloud Optical Thickness*CLTMODIS', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float tauwmodis ( time, loc ) - call addfld ('TAUWMODIS',horiz_only,'A','1','MODIS Liquid Cloud Optical Thickness*CLWMODIS', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float tauimodis ( time, loc ) - call addfld ('TAUIMODIS',horiz_only,'A','1','MODIS Ice Cloud Optical Thickness*CLIMODIS', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float tautlogmodis ( time, loc ) - call addfld ('TAUTLOGMODIS',horiz_only,'A','1','MODIS Total Cloud Optical Thickness (Log10 Mean)*CLTMODIS', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float tauwlogmodis ( time, loc ) - call addfld ('TAUWLOGMODIS',horiz_only,'A','1','MODIS Liquid Cloud Optical Thickness (Log10 Mean)*CLWMODIS', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float tauilogmodis ( time, loc ) - call addfld ('TAUILOGMODIS',horiz_only,'A','1','MODIS Ice Cloud Optical Thickness (Log10 Mean)*CLIMODIS', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float reffclwmodis ( time, loc ) - call addfld ('REFFCLWMODIS',horiz_only,'A','m','MODIS Liquid Cloud Particle Size*CLWMODIS', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float reffclimodis ( time, loc ) - call addfld ('REFFCLIMODIS',horiz_only,'A','m','MODIS Ice Cloud Particle Size*CLIMODIS', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float pctmodis ( time, loc ) - call addfld ('PCTMODIS',horiz_only,'A','Pa','MODIS Cloud Top Pressure*CLTMODIS',flag_xyfill=.true., fill_value=R_UNDEF) - ! float lwpmodis ( time, loc ) - call addfld ('LWPMODIS',horiz_only,'A','kg m-2','MODIS Cloud Liquid Water Path*CLWMODIS', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float iwpmodis ( time, loc ) - call addfld ('IWPMODIS',horiz_only,'A','kg m-2','MODIS Cloud Ice Water Path*CLIMODIS',flag_xyfill=.true., fill_value=R_UNDEF) - ! float clmodis ( time, plev, tau, loc ) - call addfld ('CLMODIS',(/'cosp_tau_modis','cosp_prs '/),'A','%','MODIS Cloud Area Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float clrimodis ( time, plev, tau, loc ) - call addfld ('CLRIMODIS',(/'cosp_tau_modis','cosp_reffice '/),'A','%','MODIS Cloud Area Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float clrlmodis ( time, plev, tau, loc ) - call addfld ('CLRLMODIS',(/'cosp_tau_modis','cosp_reffliq '/),'A','%','MODIS Cloud Area Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLTMODIS', horiz_only, 'A', '%', & + 'MODIS Total Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLWMODIS', horiz_only, 'A', '%', & + 'MODIS Liquid Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLIMODIS', horiz_only, 'A', '%', & + 'MODIS Ice Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLHMODIS', horiz_only, 'A', '%', & + 'MODIS High Level Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLMMODIS', horiz_only, 'A', '%', & + 'MODIS Mid Level Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLLMODIS', horiz_only, 'A', '%', & + 'MODIS Low Level Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('TAUTMODIS', horiz_only, 'A', '1', & + 'MODIS Total Cloud Optical Thickness*CLTMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('TAUWMODIS', horiz_only, 'A', '1', & + 'MODIS Liquid Cloud Optical Thickness*CLWMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('TAUIMODIS', horiz_only, 'A', '1', & + 'MODIS Ice Cloud Optical Thickness*CLIMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('TAUTLOGMODIS', horiz_only, 'A', '1', & + 'MODIS Total Cloud Optical Thickness (Log10 Mean)*CLTMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('TAUWLOGMODIS', horiz_only, 'A', '1', & + 'MODIS Liquid Cloud Optical Thickness (Log10 Mean)*CLWMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('TAUILOGMODIS', horiz_only, 'A', '1', & + 'MODIS Ice Cloud Optical Thickness (Log10 Mean)*CLIMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('REFFCLWMODIS', horiz_only, 'A', 'm', & + 'MODIS Liquid Cloud Particle Size*CLWMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('REFFCLIMODIS', horiz_only, 'A', 'm', & + 'MODIS Ice Cloud Particle Size*CLIMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('PCTMODIS', horiz_only, 'A', 'Pa', & + 'MODIS Cloud Top Pressure*CLTMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('LWPMODIS', horiz_only, 'A', 'kg m-2', & + 'MODIS Cloud Liquid Water Path*CLWMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('IWPMODIS', horiz_only, 'A', 'kg m-2', & + 'MODIS Cloud Ice Water Path*CLIMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLMODIS', (/'cosp_tau_modis','cosp_prs '/), 'A', '%', & + 'MODIS Cloud Area Fraction (tau-pressure histogram)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLRIMODIS', (/'cosp_tau_modis','cosp_reffice '/), 'A', '%', & + 'MODIS Cloud Area Fraction (tau-reffice histogram)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLRLMODIS', (/'cosp_tau_modis','cosp_reffliq '/), 'A', '%', & + 'MODIS Cloud Area Fraction (tau-reffliq histogram)', flag_xyfill=.true., fill_value=R_UNDEF) - !! add MODIS output to history file specified by the CAM namelist variable cosp_histfile_num - call add_default ('CLTMODIS',cosp_histfile_num,' ') - call add_default ('CLWMODIS',cosp_histfile_num,' ') - call add_default ('CLIMODIS',cosp_histfile_num,' ') - call add_default ('CLHMODIS',cosp_histfile_num,' ') - call add_default ('CLMMODIS',cosp_histfile_num,' ') - call add_default ('CLLMODIS',cosp_histfile_num,' ') - call add_default ('TAUTMODIS',cosp_histfile_num,' ') - call add_default ('TAUWMODIS',cosp_histfile_num,' ') - call add_default ('TAUIMODIS',cosp_histfile_num,' ') - call add_default ('TAUTLOGMODIS',cosp_histfile_num,' ') - call add_default ('TAUWLOGMODIS',cosp_histfile_num,' ') - call add_default ('TAUILOGMODIS',cosp_histfile_num,' ') - call add_default ('REFFCLWMODIS',cosp_histfile_num,' ') - call add_default ('REFFCLIMODIS',cosp_histfile_num,' ') - call add_default ('PCTMODIS',cosp_histfile_num,' ') - call add_default ('LWPMODIS',cosp_histfile_num,' ') - call add_default ('IWPMODIS',cosp_histfile_num,' ') - call add_default ('CLMODIS',cosp_histfile_num,' ') - call add_default ('CLRIMODIS',cosp_histfile_num,' ') - call add_default ('CLRLMODIS',cosp_histfile_num,' ') + call add_default('CLTMODIS',cosp_histfile_num,' ') + call add_default('CLWMODIS',cosp_histfile_num,' ') + call add_default('CLIMODIS',cosp_histfile_num,' ') + call add_default('CLHMODIS',cosp_histfile_num,' ') + call add_default('CLMMODIS',cosp_histfile_num,' ') + call add_default('CLLMODIS',cosp_histfile_num,' ') + call add_default('TAUTMODIS',cosp_histfile_num,' ') + call add_default('TAUWMODIS',cosp_histfile_num,' ') + call add_default('TAUIMODIS',cosp_histfile_num,' ') + call add_default('TAUTLOGMODIS',cosp_histfile_num,' ') + call add_default('TAUWLOGMODIS',cosp_histfile_num,' ') + call add_default('TAUILOGMODIS',cosp_histfile_num,' ') + call add_default('REFFCLWMODIS',cosp_histfile_num,' ') + call add_default('REFFCLIMODIS',cosp_histfile_num,' ') + call add_default('PCTMODIS',cosp_histfile_num,' ') + call add_default('LWPMODIS',cosp_histfile_num,' ') + call add_default('IWPMODIS',cosp_histfile_num,' ') + call add_default('CLMODIS',cosp_histfile_num,' ') + call add_default('CLRIMODIS',cosp_histfile_num,' ') + call add_default('CLRLMODIS',cosp_histfile_num,' ') end if ! SUB-COLUMN OUTPUT if (lfrac_out) then - ! frac_out (time,height_mlev,column,profile) - call addfld ('SCOPS_OUT',(/'cosp_scol','lev '/),'I','0=nocld,1=strcld,2=cnvcld','SCOPS Subcolumn output', & - flag_xyfill=.true., fill_value=R_UNDEF) - !! add scops ouptut to history file specified by the CAM namelist variable cosp_histfile_num - call add_default ('SCOPS_OUT',cosp_histfile_num,' ') - ! save sub-column outputs from ISCCP if ISCCP is run + call addfld('SCOPS_OUT', (/'cosp_scol','trop_pref'/), 'I', '0=nocld,1=strcld,2=cnvcld', & + 'SCOPS Subcolumn output', flag_xyfill=.true., fill_value=R_UNDEF) + + call add_default('SCOPS_OUT',cosp_histfile_num,' ') + if (lisccp_sim) then - call add_default ('TAU_ISCCP',cosp_histfile_num,' ') - call add_default ('CLDPTOP_ISCCP',cosp_histfile_num,' ') + call add_default('TAU_ISCCP',cosp_histfile_num,' ') + call add_default('CLDPTOP_ISCCP',cosp_histfile_num,' ') end if - ! save sub-column outputs from calipso if calipso is run + if (llidar_sim) then - call add_default ('ATB532_CAL',cosp_histfile_num,' ') + call add_default('ATB532_CAL',cosp_histfile_num,' ') end if - ! save sub-column outputs from radar if radar is run + if (lradar_sim) then - call add_default ('DBZE_CS',cosp_histfile_num,' ') + call add_default('DBZE_CS',cosp_histfile_num,' ') end if end if !! ADDFLD, ADD_DEFAULT, OUTFLD CALLS FOR COSP OUTPUTS IF RUNNING COSP OFF-LINE - !! Note: A suggestion was to add all of the CAM variables needed to add to make it possible to run COSP off-line - !! These fields are available and can be called from the namelist though. Here, when the cosp_runall mode is invoked - !! all of the inputs are saved on the cam history file. This is good de-bugging functionality we should maintain. if (cosp_histfile_aux) then - call addfld ('PS_COSP', horiz_only, 'I','Pa', 'PS_COSP', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('TS_COSP', horiz_only, 'I','K', 'TS_COSP', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('P_COSP', (/ 'lev'/), 'I','Pa', 'P_COSP', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('PH_COSP', (/ 'lev'/), 'I','Pa', 'PH_COSP', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('ZLEV_COSP', (/ 'lev'/), 'I','m', 'ZLEV_COSP', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('ZLEV_HALF_COSP', (/ 'lev'/), 'I','m', 'ZLEV_HALF_COSP', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('T_COSP', (/ 'lev'/), 'I','K', 'T_COSP', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('RH_COSP', (/ 'lev'/), 'I','percent','RH_COSP', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('Q_COSP', (/ 'lev'/), 'I','kg/kg', 'Q_COSP', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('TAU_067', (/'cosp_scol','lev '/), 'I','1', 'Subcolumn 0.67micron optical depth', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('EMISS_11', (/'cosp_scol','lev '/), 'I','1', 'Subcolumn 11micron emissivity', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('MODIS_fracliq', (/'cosp_scol','lev '/), 'I','1', 'Fraction of tau from liquid water', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('MODIS_asym', (/'cosp_scol','lev '/), 'I','1', 'Asymmetry parameter (MODIS)', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('MODIS_ssa', (/'cosp_scol','lev '/), 'I','1', 'Single-scattering albedo (MODIS)', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('CAL_betatot', (/'cosp_scol','lev '/), 'I','1', 'Backscatter coefficient (CALIPSO)', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('CAL_betatot_ice', (/'cosp_scol','lev '/), 'I','1', 'Backscatter coefficient (CALIPSO)', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('CAL_betatot_liq', (/'cosp_scol','lev '/), 'I','1', 'Backscatter coefficient (CALIPSO)', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('CAL_tautot', (/'cosp_scol','lev '/), 'I','1', 'Vertically integrated ptical-depth (CALIPSO)', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('CAL_tautot_ice', (/'cosp_scol','lev '/), 'I','1', 'Vertically integrated ptical-depth (CALIPSO)', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('CAL_tautot_liq', (/'cosp_scol','lev '/), 'I','1', 'Vertically integrated ptical-depth (CALIPSO)', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('CS_z_vol', (/'cosp_scol','lev '/), 'I','1', 'Effective reflectivity factor (CLOUDSAT)', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('CS_kr_vol', (/'cosp_scol','lev '/), 'I','1', 'Attenuation coefficient (hydro) (CLOUDSAT)', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('CS_g_vol', (/'cosp_scol','lev '/), 'I','1', 'Attenuation coefficient (gases) (CLOUDSAT)', & - flag_xyfill=.true., fill_value=R_UNDEF) - - call add_default ('PS_COSP', cosp_histfile_aux_num,' ') - call add_default ('TS_COSP', cosp_histfile_aux_num,' ') - call add_default ('P_COSP', cosp_histfile_aux_num,' ') - call add_default ('PH_COSP', cosp_histfile_aux_num,' ') - call add_default ('ZLEV_COSP', cosp_histfile_aux_num,' ') - call add_default ('ZLEV_HALF_COSP', cosp_histfile_aux_num,' ') - call add_default ('T_COSP', cosp_histfile_aux_num,' ') - call add_default ('RH_COSP', cosp_histfile_aux_num,' ') - call add_default ('TAU_067', cosp_histfile_aux_num,' ') - call add_default ('EMISS_11', cosp_histfile_aux_num,' ') - call add_default ('MODIS_fracliq', cosp_histfile_aux_num,' ') - call add_default ('MODIS_asym', cosp_histfile_aux_num,' ') - call add_default ('MODIS_ssa', cosp_histfile_aux_num,' ') - call add_default ('CAL_betatot', cosp_histfile_aux_num,' ') - call add_default ('CAL_betatot_ice', cosp_histfile_aux_num,' ') - call add_default ('CAL_betatot_liq', cosp_histfile_aux_num,' ') - call add_default ('CAL_tautot', cosp_histfile_aux_num,' ') - call add_default ('CAL_tautot_ice', cosp_histfile_aux_num,' ') - call add_default ('CAL_tautot_liq', cosp_histfile_aux_num,' ') - call add_default ('CS_z_vol', cosp_histfile_aux_num,' ') - call add_default ('CS_kr_vol', cosp_histfile_aux_num,' ') - call add_default ('CS_g_vol', cosp_histfile_aux_num,' ') + call addfld ('PS_COSP', horiz_only, 'I','Pa', & + 'COSP Surface Pressure', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('TS_COSP', horiz_only, 'I','K', & + 'COSP Skin Temperature', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('P_COSP', (/ 'trop_pref'/), 'I','Pa', & + 'COSP Pressure (layer midpoint)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('PH_COSP', (/ 'trop_prefi'/), 'I','Pa', & + 'COSP Pressure (layer interface)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('ZLEV_COSP', (/ 'trop_pref'/), 'I','m', & + 'COSP Height (layer midpoint)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('ZLEV_HALF_COSP', (/ 'trop_prefi'/), 'I','m', & + 'COSP Height (layer interface)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('T_COSP', (/ 'trop_pref'/), 'I','K', & + 'COSP Temperature', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('Q_COSP', (/ 'trop_pref'/), 'I','percent', & + 'COSP Specific Humidity', flag_xyfill=.true., fill_value=R_UNDEF) + + call addfld ('TAU_067', (/'cosp_scol','trop_pref'/), 'I','1', & + 'Subcolumn 0.67micron optical depth', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('EMISS_11', (/'cosp_scol','trop_pref'/), 'I','1', & + 'Subcolumn 11micron emissivity', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('MODIS_fracliq', (/'cosp_scol','trop_pref'/), 'I','1', & + 'Fraction of tau from liquid water', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('MODIS_asym', (/'cosp_scol','trop_pref'/), 'I','1', & + 'Asymmetry parameter (MODIS)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('MODIS_ssa', (/'cosp_scol','trop_pref'/), 'I','1', & + 'Single-scattering albedo (MODIS)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('CS_z_vol', (/'cosp_scol','trop_pref'/), 'I','1', & + 'Effective reflectivity factor (CLOUDSAT)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('CS_kr_vol', (/'cosp_scol','trop_pref'/), 'I','1', & + 'Attenuation coefficient (hydro) (CLOUDSAT)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('CS_g_vol', (/'cosp_scol','trop_pref'/), 'I','1', & + 'Attenuation coefficient (gases) (CLOUDSAT)', flag_xyfill=.true., fill_value=R_UNDEF) + + call add_default('PS_COSP', cosp_histfile_aux_num,' ') + call add_default('TS_COSP', cosp_histfile_aux_num,' ') + call add_default('P_COSP', cosp_histfile_aux_num,' ') + call add_default('PH_COSP', cosp_histfile_aux_num,' ') + call add_default('ZLEV_COSP', cosp_histfile_aux_num,' ') + call add_default('ZLEV_HALF_COSP', cosp_histfile_aux_num,' ') + call add_default('T_COSP', cosp_histfile_aux_num,' ') + call add_default('Q_COSP', cosp_histfile_aux_num,' ') + call add_default('TAU_067', cosp_histfile_aux_num,' ') + call add_default('EMISS_11', cosp_histfile_aux_num,' ') + call add_default('MODIS_fracliq', cosp_histfile_aux_num,' ') + call add_default('MODIS_asym', cosp_histfile_aux_num,' ') + call add_default('MODIS_ssa', cosp_histfile_aux_num,' ') + call add_default('CS_z_vol', cosp_histfile_aux_num,' ') + call add_default('CS_kr_vol', cosp_histfile_aux_num,' ') + call add_default('CS_g_vol', cosp_histfile_aux_num,' ') end if rei_idx = pbuf_get_index('REI') @@ -1173,31 +881,184 @@ subroutine cospsimulator_intr_init() lsflxprc_idx = pbuf_get_index('LS_FLXPRC') lsflxsnw_idx = pbuf_get_index('LS_FLXSNW') - allocate(first_run_cosp(begchunk:endchunk)) + allocate(first_run_cosp(begchunk:endchunk), run_cosp(1:pcols,begchunk:endchunk), & + stat=istat) + call handle_allocate_error(istat, sub, '*run_cosp') first_run_cosp(begchunk:endchunk)=.true. - allocate(run_cosp(1:pcols,begchunk:endchunk)) run_cosp(1:pcols,begchunk:endchunk)=.false. #endif end subroutine cospsimulator_intr_init + ! ###################################################################################### + ! SUBROUTINE setcosp2values + ! ###################################################################################### +#ifdef USE_COSP + subroutine setcosp2values() + use mod_cosp, only: cosp_init + use mod_cosp_config, only: vgrid_zl, vgrid_zu, vgrid_z + use mod_quickbeam_optics, only: hydro_class_init, quickbeam_optics_init + + ! Local + logical :: ldouble=.false. + logical :: lsingle=.true. ! Default is to use single moment + integer :: k + integer :: istat + character(len=*), parameter :: sub = 'setcosp2values' + !-------------------------------------------------------------------------------------- + + prsmid_cosp = pres_binCenters + prslim_cosp = pres_binEdges + taumid_cosp = tau_binCenters + taulim_cosp = tau_binEdges + srmid_cosp = calipso_binCenters + srlim_cosp = calipso_binEdges + sza_cosp = parasol_sza + dbzemid_cosp = cloudsat_binCenters + dbzelim_cosp = cloudsat_binEdges + htmisrmid_cosp = misr_histHgtCenters + htmisrlim_cosp = misr_histHgtEdges + taumid_cosp_modis = tau_binCenters + taulim_cosp_modis = tau_binEdges + reffICE_binCenters_cosp = reffICE_binCenters + reffICE_binEdges_cosp = reffICE_binEdges + reffLIQ_binCenters_cosp = reffLIQ_binCenters + reffLIQ_binEdges_cosp = reffLIQ_binEdges + + ! Initialize the distributional parameters for hydrometeors in radar simulator. In COSPv1.4, this was declared in + ! cosp_defs.f. + if (cloudsat_micro_scheme == 'MMF_v3.5_two_moment') then + ldouble = .true. + lsingle = .false. + endif + call hydro_class_init(lsingle,ldouble,sd) + call quickbeam_optics_init() + + ! DS2017: The setting up of the vertical grid for regridding the CALIPSO and Cloudsat products is + ! now done in cosp_init, but these fields are stored in cosp_config.F90. + ! Additionally all static fields used by the individual simulators are set up by calls + ! to _init functions in cosp_init. + ! DS2019: Add logicals, default=.false., for new Lidar simuldators (Earthcare (atlid) and ground-based + ! lidar at 532nm) + call COSP_INIT(Lisccp_sim, Lmodis_sim, Lmisr_sim, Lradar_sim, Llidar_sim, LgrLidar532, & + Latlid, Lparasol_sim, Lrttov_sim, radar_freq, k2, use_gas_abs, do_ray, & + isccp_topheight, isccp_topheight_direction, surface_radar, rcfg_cloudsat, & + use_vgrid, csat_vgrid, Nlr, nlay, cloudsat_micro_scheme) + + if (use_vgrid) then !! using fixed vertical grid + if (csat_vgrid) then + nht_cosp = 40 + else + nht_cosp = Nlr + endif + endif + + ! DJS2017: In COSP2, most of the bin boundaries, centers, and edges are declared in src/cosp_config.F90. + ! Above I just assign them accordingly in the USE statement. Other bin bounds needed by CAM + ! are calculated here. + + allocate( & + htmlmid_cosp(nlay), & + htdbze_dbzemid_cosp(nht_cosp*CLOUDSAT_DBZE_BINS), & + htlim_cosp(2,nht_cosp), & + htmid_cosp(nht_cosp), & + htlim_cosp_1d(nht_cosp+1), & + htdbze_htmid_cosp(nht_cosp*CLOUDSAT_DBZE_BINS), & + htsr_htmid_cosp(nht_cosp*nsr_cosp), & + htsr_srmid_cosp(nht_cosp*nsr_cosp), & + htmlscol_htmlmid_cosp(nlay*nscol_cosp), & + htmlscol_scol_cosp(nlay*nscol_cosp), & + scol_cosp(nscol_cosp), & + htdbze_cosp(nht_cosp*CLOUDSAT_DBZE_BINS), & + htsr_cosp(nht_cosp*nsr_cosp), & + htmlscol_cosp(nlay*nscol_cosp), stat=istat) + call handle_allocate_error(istat, sub, 'htmlmid_cosp,..,htmlscol_cosp') + + ! DJS2017: Just pull from cosp_config + if (use_vgrid) then + htlim_cosp_1d(1) = vgrid_zu(1) + htlim_cosp_1d(2:nht_cosp+1) = vgrid_zl + endif + htmid_cosp = vgrid_z + htlim_cosp(1,:) = vgrid_zu + htlim_cosp(2,:) = vgrid_zl + + scol_cosp(:) = (/(k,k=1,nscol_cosp)/) + + ! Just using an index here, model height is a prognostic variable + htmlmid_cosp(:) = (/(k,k=1,nlay)/) + + ! assign mixed dimensions an integer index for cam_history.F90 + do k=1,nprs_cosp*ntau_cosp + prstau_cosp(k) = k + end do + do k=1,nprs_cosp*ntau_cosp_modis + prstau_cosp_modis(k) = k + end do + do k=1,nht_cosp*CLOUDSAT_DBZE_BINS + htdbze_cosp(k) = k + end do + do k=1,nht_cosp*nsr_cosp + htsr_cosp(k) = k + end do + do k=1,nlay*nscol_cosp + htmlscol_cosp(k) = k + end do + do k=1,nhtmisr_cosp*ntau_cosp + htmisrtau_cosp(k) = k + end do + + ! next, assign collapsed reference vectors for cam_history.F90 + ! convention for saving output = prs1,tau1 ... prs1,tau7 ; prs2,tau1 ... prs2,tau7 etc. + ! actual output is specified in cospsimulator_intr_init. + do k=1,nprs_cosp + prstau_taumid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=taumid_cosp(1:ntau_cosp) + prstau_prsmid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=prsmid_cosp(k) + prstau_taumid_cosp_modis(ntau_cosp_modis*(k-1)+1:k*ntau_cosp_modis)=taumid_cosp_modis(1:ntau_cosp_modis) + prstau_prsmid_cosp_modis(ntau_cosp_modis*(k-1)+1:k*ntau_cosp_modis)=prsmid_cosp(k) + enddo + + do k=1,nht_cosp + htdbze_dbzemid_cosp(CLOUDSAT_DBZE_BINS*(k-1)+1:k*CLOUDSAT_DBZE_BINS)=dbzemid_cosp(1:CLOUDSAT_DBZE_BINS) + htdbze_htmid_cosp(CLOUDSAT_DBZE_BINS*(k-1)+1:k*CLOUDSAT_DBZE_BINS)=htmid_cosp(k) + enddo + + do k=1,nht_cosp + htsr_srmid_cosp(nsr_cosp*(k-1)+1:k*nsr_cosp)=srmid_cosp(1:nsr_cosp) + htsr_htmid_cosp(nsr_cosp*(k-1)+1:k*nsr_cosp)=htmid_cosp(k) + enddo + + do k=1,nlay + htmlscol_scol_cosp(nscol_cosp*(k-1)+1:k*nscol_cosp)=scol_cosp(1:nscol_cosp) + htmlscol_htmlmid_cosp(nscol_cosp*(k-1)+1:k*nscol_cosp)=htmlmid_cosp(k) + enddo + + do k=1,nhtmisr_cosp + htmisrtau_taumid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=taumid_cosp(1:ntau_cosp) + htmisrtau_htmisrmid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=htmisrmid_cosp(k) + enddo + + end subroutine setcosp2values +#endif + ! ###################################################################################### ! SUBROUTINE cospsimulator_intr_run ! ###################################################################################### - subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,snow_tau_in,snow_emis_in) + subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & + cld_swtau_in, snow_tau_in, snow_emis_in) + use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx use camsrfexch, only: cam_in_t use constituents, only: cnst_get_ind use rad_constituents, only: rad_cnst_get_gas - use wv_saturation, only: qsat_water use interpolate_data, only: lininterp_init,lininterp,lininterp_finish,interp_type - use physconst, only: pi, gravit + use physconst, only: pi, inverse_gravit => rga use cam_history, only: outfld,hist_fld_col_active use cam_history_support, only: max_fieldname_len - use cmparray_mod, only: CmpDayNite, ExpDayNite + #ifdef USE_COSP - use mod_cosp_config, only: R_UNDEF,parasol_nrefl, Nlvgrid, vgrid_zl, vgrid_zu + use mod_cosp_config, only: R_UNDEF,parasol_nrefl, Nlvgrid use mod_cosp, only: cosp_simulator use mod_quickbeam_optics, only: size_distribution #endif @@ -1220,69 +1081,20 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn ! ###################################################################################### integer :: lchnk ! chunk identifier integer :: ncol ! number of active atmospheric columns - integer :: i,k,ip,it,ipt,ih,id,ihd,is,ihs,isc,ihsc,ihm,ihmt,ihml,itim_old,ifld - - ! Variables for day/nite and orbital subsetting - ! Gathered indicies of day and night columns - ! chunk_column_index = IdxDay(daylight_column_index) - integer :: Nday ! Number of daylight columns - integer :: Nno ! Number of columns not using for simulator - integer, dimension(pcols) :: IdxDay ! Indices of daylight columns - integer, dimension(pcols) :: IdxNo ! Indices of columns not using for simulator - real(r8) :: tmp(pcols) ! tempororary variable for array expansion - real(r8) :: tmp1(pcols,pver) ! tempororary variable for array expansion - real(r8) :: tmp2(pcols,pver) ! tempororary variable for array expansion - real(r8) :: lon_cosp_day(pcols) ! tempororary variable for sunlit lons - real(r8) :: lat_cosp_day(pcols) ! tempororary variable for sunlit lats - real(r8) :: ptop_day(pcols,pver) ! tempororary variable for sunlit ptop - real(r8) :: pmid_day(pcols,pver) ! tempororary variable for sunlit pmid - real(r8) :: ztop_day(pcols,pver) ! tempororary variable for sunlit ztop - real(r8) :: zmid_day(pcols,pver) ! tempororary variable for sunlit zmid - real(r8) :: t_day(pcols,pver) ! tempororary variable for sunlit t - real(r8) :: rh_day(pcols,pver) ! tempororary variable for sunlit rh - real(r8) :: q_day(pcols,pver) ! tempororary variable for sunlit q - real(r8) :: concld_day(pcols,pver) ! tempororary variable for sunlit concld - real(r8) :: cld_day(pcols,pver) ! tempororary variable for sunlit cld - real(r8) :: ps_day(pcols) ! tempororary variable for sunlit ps - real(r8) :: ts_day(pcols) ! tempororary variable for sunlit ts - real(r8) :: landmask_day(pcols) ! tempororary variable for sunlit landmask - real(r8) :: o3_day(pcols,pver) ! tempororary variable for sunlit o3 - real(r8) :: us_day(pcols) ! tempororary variable for sunlit us - real(r8) :: vs_day(pcols) ! tempororary variable for sunlit vs - real(r8) :: mr_lsliq_day(pcols,pver) ! tempororary variable for sunlit mr_lsliq - real(r8) :: mr_lsice_day(pcols,pver) ! tempororary variable for sunlit mr_lsice - real(r8) :: mr_ccliq_day(pcols,pver) ! tempororary variable for sunlit mr_ccliq - real(r8) :: mr_ccice_day(pcols,pver) ! tempororary variable for sunlit mr_ccice - real(r8) :: rain_ls_interp_day(pcols,pver) ! tempororary variable for sunlit rain_ls_interp - real(r8) :: snow_ls_interp_day(pcols,pver) ! tempororary variable for sunlit snow_ls_interp - real(r8) :: grpl_ls_interp_day(pcols,pver) ! tempororary variable for sunlit grpl_ls_interp - real(r8) :: rain_cv_interp_day(pcols,pver) ! tempororary variable for sunlit rain_cv_interp - real(r8) :: snow_cv_interp_day(pcols,pver) ! tempororary variable for sunlit snow_cv_interp - real(r8) :: reff_cosp_day(pcols,pver,nhydro) ! tempororary variable for sunlit reff_cosp(:,:,:) - real(r8) :: dtau_s_day(pcols,pver) ! tempororary variable for sunlit dtau_s - real(r8) :: dtau_c_day(pcols,pver) ! tempororary variable for sunlit dtau_c - real(r8) :: dtau_s_snow_day(pcols,pver) ! tempororary variable for sunlit dtau_s_snow - real(r8) :: dem_s_day(pcols,pver) ! tempororary variable for sunlit dem_s - real(r8) :: dem_c_day(pcols,pver) ! tempororary variable for sunlit dem_c - real(r8) :: dem_s_snow_day(pcols,pver) ! tempororary variable for sunlit dem_s_snow - - ! Constants for optical depth calculation (from radcswmx.F90) - real(r8), parameter :: abarl = 2.817e-02_r8 ! A coefficient for extinction optical depth - real(r8), parameter :: bbarl = 1.305_r8 ! b coefficient for extinction optical depth - real(r8), parameter :: abari = 3.448e-03_r8 ! A coefficient for extinction optical depth - real(r8), parameter :: bbari = 2.431_r8 ! b coefficient for extinction optical depth - real(r8), parameter :: cldmin = 1.0e-80_r8 ! note: cldmin much less than cldmin from cldnrh - real(r8), parameter :: cldeps = 0.0_r8 + integer :: i, k, kk + integer :: itim_old + integer :: ip, it + integer :: ipt + integer :: ih, ihd, ihs, ihsc, ihm, ihmt, ihml + integer :: isc + integer :: is + integer :: id + + real(r8), parameter :: rad2deg = 180._r8/pi ! Microphysics variables - integer, parameter :: ncnstmax=4 ! number of constituents - character(len=8), dimension(ncnstmax), parameter :: & ! constituent names - cnst_names = (/'CLDLIQ', 'CLDICE','NUMLIQ','NUMICE'/) - integer :: ncnst ! number of constituents (can vary) integer :: ixcldliq ! cloud liquid amount index for state%q integer :: ixcldice ! cloud ice amount index - integer :: ixnumliq ! cloud liquid number index - integer :: ixnumice ! cloud ice water index ! COSP-related local vars type(cosp_outputs) :: cospOUT ! COSP simulator outputs @@ -1290,52 +1102,37 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn type(cosp_column_inputs) :: cospstateIN ! COSP model fields needed by simulators ! COSP input variables that depend on CAM - ! 1) Npoints = number of gridpoints COSP will process (without subsetting, Npoints=ncol) - ! 2) Nlevels = number of model levels (Nlevels=pver) - real(r8), parameter :: time = 1.0_r8 ! time ! Time since start of run [days], set to 1 bc running over single CAM timestep - real(r8), parameter :: time_bnds(2)=(/0.5_r8,1.5_r8/) ! time_bnds ! Time boundaries - new in cosp v1.3, set following cosp_test.f90 line 121 integer :: Npoints ! Number of gridpoints COSP will process - integer :: Nlevels ! Nlevels - logical :: use_reff ! True if effective radius to be used by radar simulator - ! (always used by lidar) - logical :: use_precipitation_fluxes ! True if precipitation fluxes are input to the algorithm real(r8), parameter :: emsfc_lw = 0.99_r8 ! longwave emissivity of surface at 10.5 microns - ! set value same as in cloudsimulator.F90 ! Local vars related to calculations to go from CAM input to COSP input ! cosp convective value includes both deep and shallow convection - real(r8) :: ptop(pcols,pver) ! top interface pressure (Pa) - real(r8) :: ztop(pcols,pver) ! top interface height asl (m) - real(r8) :: pbot(pcols,pver) ! bottom interface pressure (Pa) - real(r8) :: zbot(pcols,pver) ! bottom interface height asl (m) - real(r8) :: zmid(pcols,pver) ! middle interface height asl (m) - real(r8) :: lat_cosp(pcols) ! lat for cosp (degrees_north) - real(r8) :: lon_cosp(pcols) ! lon for cosp (degrees_east) - real(r8) :: landmask(pcols) ! landmask (0 or 1) - real(r8) :: mr_lsliq(pcols,pver) ! mixing_ratio_large_scale_cloud_liquid (kg/kg) - real(r8) :: mr_lsice(pcols,pver) ! mixing_ratio_large_scale_cloud_ice (kg/kg) - real(r8) :: mr_ccliq(pcols,pver) ! mixing_ratio_convective_cloud_liquid (kg/kg) - real(r8) :: mr_ccice(pcols,pver) ! mixing_ratio_convective_cloud_ice (kg/kg) - real(r8) :: rain_cv(pcols,pverp) ! interface flux_convective_cloud_rain (kg m^-2 s^-1) - real(r8) :: snow_cv(pcols,pverp) ! interface flux_convective_cloud_snow (kg m^-2 s^-1) - real(r8) :: rain_cv_interp(pcols,pver) ! midpoint flux_convective_cloud_rain (kg m^-2 s^-1) - real(r8) :: snow_cv_interp(pcols,pver) ! midpoint flux_convective_cloud_snow (kg m^-2 s^-1) - real(r8) :: grpl_ls_interp(pcols,pver) ! midpoint ls grp flux, should be 0 - real(r8) :: rain_ls_interp(pcols,pver) ! midpoint ls rain flux (kg m^-2 s^-1) - real(r8) :: snow_ls_interp(pcols,pver) ! midpoint ls snow flux - real(r8) :: reff_cosp(pcols,pver,nhydro) ! effective radius for cosp input - real(r8) :: rh(pcols,pver) ! relative_humidity_liquid_water (%) - real(r8) :: es(pcols,pver) ! saturation vapor pressure - real(r8) :: qs(pcols,pver) ! saturation mixing ratio (kg/kg), saturation specific humidity - real(r8) :: cld_swtau(pcols,pver) ! incloud sw tau for input to COSP - real(r8) :: dtau_s(pcols,pver) ! dtau_s - Optical depth of stratiform cloud at 0.67 um - real(r8) :: dtau_c(pcols,pver) ! dtau_c - Optical depth of convective cloud at 0.67 um - real(r8) :: dtau_s_snow(pcols,pver) ! dtau_s_snow - Grid-box mean Optical depth of stratiform snow at 0.67 um - real(r8) :: dem_s(pcols,pver) ! dem_s - Longwave emis of stratiform cloud at 10.5 um - real(r8) :: dem_c(pcols,pver) ! dem_c - Longwave emis of convective cloud at 10.5 um - real(r8) :: dem_s_snow(pcols,pver) ! dem_s_snow - Grid-box mean Optical depth of stratiform snow at 10.5 um - integer :: cam_sunlit(pcols) ! cam_sunlit - Sunlit flag(1-sunlit/0-dark). - integer :: nSunLit,nNoSunLit ! Number of sunlit (not sunlit) scenes. + real(r8), allocatable :: & + zmid(:,:), & ! layer midpoint height asl (m) + zint(:,:), & ! layer interface height asl (m) + surf_hgt(:), & ! surface height (m) + landmask(:), & ! landmask (0 or 1) + mr_ccliq(:,:), & ! mixing_ratio_convective_cloud_liquid (kg/kg) + mr_ccice(:,:), & ! mixing_ratio_convective_cloud_ice (kg/kg) + mr_lsliq(:,:), & ! mixing_ratio_large_scale_cloud_liquid (kg/kg) + mr_lsice(:,:), & ! mixing_ratio_large_scale_cloud_ice (kg/kg) + rain_cv(:,:), & ! interface flux_convective_cloud_rain (kg m^-2 s^-1) + snow_cv(:,:), & ! interface flux_convective_cloud_snow (kg m^-2 s^-1) + rain_cv_interp(:,:), & ! midpoint flux_convective_cloud_rain (kg m^-2 s^-1) + snow_cv_interp(:,:), & ! midpoint flux_convective_cloud_snow (kg m^-2 s^-1) + rain_ls_interp(:,:), & ! midpoint ls rain flux (kg m^-2 s^-1) + snow_ls_interp(:,:), & ! midpoint ls snow flux + grpl_ls_interp(:,:), & ! midpoint ls grp flux, set to 0 + reff_cosp(:,:,:), & ! effective radius for cosp input + dtau_s(:,:), & ! Optical depth of stratiform cloud at 0.67 um + dtau_c(:,:), & ! Optical depth of convective cloud at 0.67 um + dtau_s_snow(:,:), & ! Grid-box mean Optical depth of stratiform snow at 0.67 um + dem_s(:,:), & ! Longwave emis of stratiform cloud at 10.5 um + dem_c(:,:), & ! Longwave emis of convective cloud at 10.5 um + dem_s_snow(:,:) ! Grid-box mean Optical depth of stratiform snow at 10.5 um + + integer :: cam_sunlit(pcols) ! cam_sunlit - Sunlit flag(1-sunlit/0-dark). + integer :: nSunLit ! Number of sunlit (not sunlit) scenes. ! ###################################################################################### ! Simulator output info @@ -1353,9 +1150,7 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn 'CS_NOPRECIP ', 'CS_RAINPOSS ', 'CS_RAINPROB ', & 'CS_RAINCERT ', 'CS_SNOWPOSS ', 'CS_SNOWCERT ', & 'CS_MIXPOSS ', 'CS_MIXCERT ', 'CS_RAINHARD ', & - 'CS_UN ', 'CS_PIA '/)!, 'CAM_MP_CVRAIN ', & - !'CAM_MP_CVSNOW ', 'CAM_MP_LSRAIN ', 'CAM_MP_LSSNOW ', & - !'CAM_MP_LSGRPL '/) + 'CS_UN ', 'CS_PIA '/) ! CALIPSO outputs character(len=max_fieldname_len),dimension(nf_calipso),parameter :: & @@ -1364,11 +1159,7 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn 'CLD_CAL_ICE ','CLD_CAL_UN ','CLD_CAL_TMP ','CLD_CAL_TMPLIQ ','CLD_CAL_TMPICE ',& 'CLD_CAL_TMPUN ','CLDTOT_CAL_ICE ','CLDTOT_CAL_LIQ ','CLDTOT_CAL_UN ','CLDHGH_CAL_ICE ',& 'CLDHGH_CAL_LIQ ','CLDHGH_CAL_UN ','CLDMED_CAL_ICE ','CLDMED_CAL_LIQ ','CLDMED_CAL_UN ',& - 'CLDLOW_CAL_ICE ','CLDLOW_CAL_LIQ ','CLDLOW_CAL_UN '/)!, & -! 'CLDOPQ_CAL ','CLDTHN_CAL ','CLDZOPQ_CAL ','CLDOPQ_CAL_2D ','CLDTHN_CAL_2D ',& -! 'CLDZOPQ_CAL_2D ','OPACITY_CAL_2D ','CLDOPQ_CAL_TMP ','CLDTHN_CAL_TMP ','CLDZOPQ_CAL_TMP',& -! 'CLDOPQ_CAL_Z ','CLDTHN_CAL_Z ','CLDTHN_CAL_EMIS','CLDOPQ_CAL_SE ','CLDTHN_CAL_SE ',& -! 'CLDZOPQ_CAL_SE' /) + 'CLDLOW_CAL_ICE ','CLDLOW_CAL_LIQ ','CLDLOW_CAL_UN '/) ! ISCCP outputs character(len=max_fieldname_len),dimension(nf_isccp),parameter :: & fname_isccp=(/'FISCCP1_COSP ','CLDTOT_ISCCP ','MEANCLDALB_ISCCP',& @@ -1386,7 +1177,7 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn 'CLRLMODIS '/) logical :: run_radar(nf_radar,pcols) ! logical telling you if you should run radar simulator - logical :: run_calipso(nf_calipso,pcols) ! logical telling you if you should run calipso simulator + logical :: run_calipso(nf_calipso,pcols) ! logical telling you if you should run calipso simulator logical :: run_isccp(nf_isccp,pcols) ! logical telling you if you should run isccp simulator logical :: run_misr(nf_misr,pcols) ! logical telling you if you should run misr simulator logical :: run_modis(nf_modis,pcols) ! logical telling you if you should run modis simulator @@ -1394,9 +1185,6 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn ! CAM pointers to get variables from radiation interface (get from rad_cnst_get_gas) real(r8), pointer, dimension(:,:) :: q ! specific humidity (kg/kg) real(r8), pointer, dimension(:,:) :: o3 ! Mass mixing ratio 03 - real(r8), pointer, dimension(:,:) :: co2 ! Mass mixing ratio C02 - real(r8), pointer, dimension(:,:) :: ch4 ! Mass mixing ratio CH4 - real(r8), pointer, dimension(:,:) :: n2o ! Mass mixing ratio N20 ! CAM pointers to get variables from the physics buffer real(r8), pointer, dimension(:,:) :: cld ! cloud fraction, tca - total_cloud_amount (0-1) @@ -1408,103 +1196,70 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn real(r8), pointer, dimension(:,:) :: cv_reffliq ! convective cld liq effective drop radius (microns) real(r8), pointer, dimension(:,:) :: cv_reffice ! convective cld ice effective drop size (microns) - !! precip flux pointers (use for cam4 or cam5) + !! precip flux pointers real(r8), target, dimension(pcols,pverp) :: zero_ifc ! zero array for interface fields not in the pbuf - ! Added pointers; pbuff in zm_conv_intr.F90, calc in zm_conv.F90 real(r8), pointer, dimension(:,:) :: dp_flxprc ! deep interface gbm flux_convective_cloud_rain+snow (kg m^-2 s^-1) real(r8), pointer, dimension(:,:) :: dp_flxsnw ! deep interface gbm flux_convective_cloud_snow (kg m^-2 s^-1) - ! More pointers; pbuf in convect_shallow.F90, calc in hk_conv.F90/convect_shallow.F90 (CAM4), uwshcu.F90 (CAM5) real(r8), pointer, dimension(:,:) :: sh_flxprc ! shallow interface gbm flux_convective_cloud_rain+snow (kg m^-2 s^-1) real(r8), pointer, dimension(:,:) :: sh_flxsnw ! shallow interface gbm flux_convective_cloud_snow (kg m^-2 s^-1) - ! More pointers; pbuf in stratiform.F90, getting from pbuf here - ! a) added as output to pcond subroutine in cldwat.F90 and to nmicro_pcond subroutine in cldwat2m_micro.F90 real(r8), pointer, dimension(:,:) :: ls_flxprc ! stratiform interface gbm flux_cloud_rain+snow (kg m^-2 s^-1) real(r8), pointer, dimension(:,:) :: ls_flxsnw ! stratiform interface gbm flux_cloud_snow (kg m^-2 s^-1) !! cloud mixing ratio pointers (note: large-scale in state) - ! More pointers; pbuf in convect_shallow.F90 (cam4) or stratiform.F90 (cam5) - ! calc in hk_conv.F90 (CAM4 should be 0!), uwshcu.F90 but then affected by micro so values from stratiform.F90 (CAM5) real(r8), pointer, dimension(:,:) :: sh_cldliq ! shallow gbm cloud liquid water (kg/kg) real(r8), pointer, dimension(:,:) :: sh_cldice ! shallow gbm cloud ice water (kg/kg) - ! More pointers; pbuf in zm_conv_intr.F90, calc in zm_conv.F90, 0 for CAM4 and CAM5 (same convection scheme) real(r8), pointer, dimension(:,:) :: dp_cldliq ! deep gbm cloud liquid water (kg/kg) real(r8), pointer, dimension(:,:) :: dp_cldice ! deep gmb cloud ice water (kg/kg) ! Output CAM variables - ! Notes: - ! 1) use pcols (maximum number of columns that code could use, maybe 16) - ! pcols vs. ncol. ncol is the number of columns a chunk is actually using, pcols is maximum number - ! 2) Mixed variables rules/notes, need to collapse because CAM history does not support increased dimensionality - ! MIXED DIMS: ntau_cosp*nprs_cosp, CLOUDSAT_DBZE_BINS*nht_cosp, nsr_cosp*nht_cosp, nscol_cosp*nhtml_cosp, ntau_cosp*nhtmisr_cosp - ! a) always making mixed variables VERTICAL*OTHER, e.g., pressure*tau or ht*dbze - ! b) always collapsing output as V1_1/V2_1...V1_1/V2_N ; V1_2/V2_1 ...V1_2/V2_N etc. to V1_N/V2_1 ... V1_N/V2_N - ! c) here, need vars for both multi-dimensional output from COSP, and two-dimensional output from CAM - ! 3) ntime=1, nprofile=ncol - ! 4) dimensions listed in COSP units are from netcdf output from cosp test case, and are not necessarily in the - ! correct order. In fact, most of them are not as I discovered after trying to run COSP in-line. - ! BE says this could be because FORTRAN and C (netcdf defaults to C) have different conventions. - ! 5) !! Note: after running COSP, it looks like height_mlev is actually the model levels after all!! - real(r8) :: clisccp2(pcols,ntau_cosp,nprs_cosp) ! clisccp2 (time,tau,plev,profile) - real(r8) :: cfad_dbze94(pcols,CLOUDSAT_DBZE_BINS,nht_cosp) ! cfad_dbze94 (time,height,dbze,profile) - real(r8) :: cfad_lidarsr532(pcols,nsr_cosp,nht_cosp) ! cfad_lidarsr532 (time,height,scat_ratio,profile) - real(r8) :: dbze94(pcols,nscol_cosp,nhtml_cosp) ! dbze94 (time,height_mlev,column,profile) - real(r8) :: atb532(pcols,nscol_cosp,nhtml_cosp) ! atb532 (time,height_mlev,column,profile) - real(r8) :: clMISR(pcols,ntau_cosp,nhtmisr_cosp) ! clMISR (time,tau,CTH_height_bin,profile) - real(r8) :: frac_out(pcols,nscol_cosp,nhtml_cosp) ! frac_out (time,height_mlev,column,profile) - real(r8) :: cldtot_isccp(pcols) ! CAM tclisccp (time,profile) - real(r8) :: meancldalb_isccp(pcols) ! CAM albisccp (time,profile) - real(r8) :: meanptop_isccp(pcols) ! CAM ctpisccp (time,profile) - real(r8) :: cldlow_cal(pcols) ! CAM cllcalipso (time,profile) - real(r8) :: cldmed_cal(pcols) ! CAM clmcalipso (time,profile) - real(r8) :: cldhgh_cal(pcols) ! CAM clhcalipso (time,profile) - real(r8) :: cldtot_cal(pcols) ! CAM cltcalipso (time,profile) - real(r8) :: cldtot_cal_ice(pcols) ! CAM (time,profile) !!+cosp1.4 - real(r8) :: cldtot_cal_liq(pcols) ! CAM (time,profile) - real(r8) :: cldtot_cal_un(pcols) ! CAM (time,profile) - real(r8) :: cldhgh_cal_ice(pcols) ! CAM (time,profile) - real(r8) :: cldhgh_cal_liq(pcols) ! CAM (time,profile) - real(r8) :: cldhgh_cal_un(pcols) ! CAM (time,profile) - real(r8) :: cldmed_cal_ice(pcols) ! CAM (time,profile) - real(r8) :: cldmed_cal_liq(pcols) ! CAM (time,profile) - real(r8) :: cldmed_cal_un(pcols) ! CAM (time,profile) - real(r8) :: cldlow_cal_ice(pcols) ! CAM (time,profile) - real(r8) :: cldlow_cal_liq(pcols) ! CAM (time,profile) - real(r8) :: cldlow_cal_un(pcols) ! CAM (time,profile) !+cosp1.4 - real(r8) :: cld_cal(pcols,nht_cosp) ! CAM clcalipso (time,height,profile) - real(r8) :: cld_cal_liq(pcols,nht_cosp) ! CAM (time,height,profile) !+cosp1.4 - real(r8) :: cld_cal_ice(pcols,nht_cosp) ! CAM (time,height,profile) - real(r8) :: cld_cal_un(pcols,nht_cosp) ! CAM (time,height,profile) - real(r8) :: cld_cal_tmp(pcols,nht_cosp) ! CAM (time,height,profile) - real(r8) :: cld_cal_tmpliq(pcols,nht_cosp) ! CAM (time,height,profile) - real(r8) :: cld_cal_tmpice(pcols,nht_cosp) ! CAM (time,height,profile) - real(r8) :: cld_cal_tmpun(pcols,nht_cosp) ! CAM (time,height,profile) !+cosp1.4 -! real(r8) :: cldopaq_cal(pcols) -! real(r8) :: cldthin_cal(pcols) -! real(r8) :: cldopaqz_cal(pcols) -! real(r8) :: cldopaq_cal_temp(pcols) -! real(r8) :: cldthin_cal_temp(pcols) -! real(r8) :: cldzopaq_cal_temp(pcols) -! real(r8) :: cldopaq_cal_z(pcols) -! real(r8) :: cldthin_cal_z(pcols) -! real(r8) :: cldthin_cal_emis(pcols) -! real(r8) :: cldopaq_cal_se(pcols) -! real(r8) :: cldthin_cal_se(pcols) -! real(r8) :: cldzopaq_cal_se(pcols) -! real(r8) :: cldopaq_cal_2d(pcols,nht_cosp) -! real(r8) :: cldthin_cal_2d(pcols,nht_cosp) -! real(r8) :: cldzopaq_cal_2d(pcols,nht_cosp) -! real(r8) :: opacity_cal_2d(pcols,nht_cosp) - real(r8) :: cfad_dbze94_cs(pcols,nht_cosp*CLOUDSAT_DBZE_BINS)! CAM cfad_dbze94 (time,height,dbze,profile) - real(r8) :: cfad_sr532_cal(pcols,nht_cosp*nsr_cosp) ! CAM cfad_lidarsr532 (time,height,scat_ratio,profile) - real(r8) :: tau_isccp(pcols,nscol_cosp) ! CAM boxtauisccp (time,column,profile) - real(r8) :: cldptop_isccp(pcols,nscol_cosp) ! CAM boxptopisccp (time,column,profile) - real(r8) :: meantau_isccp(pcols) ! CAM tauisccp (time,profile) - real(r8) :: meantb_isccp(pcols) ! CAM meantbisccp (time,profile) - real(r8) :: meantbclr_isccp(pcols) ! CAM meantbclrisccp (time,profile) - real(r8) :: dbze_cs(pcols,nhtml_cosp*nscol_cosp) ! CAM dbze94 (time,height_mlev,column,profile) - real(r8) :: cldtot_calcs(pcols) ! CAM cltlidarradar (time,profile) - real(r8) :: cldtot_cs(pcols) ! CAM cltradar (time,profile) - real(r8) :: cldtot_cs2(pcols) ! CAM cltradar2 (time,profile) + ! Multiple "mdims" are collapsed because CAM history buffers only support one mdim. + ! MIXED DIMS: ntau_cosp*nprs_cosp, CLOUDSAT_DBZE_BINS*nht_cosp, nsr_cosp*nht_cosp, nscol_cosp*nlay, + ! ntau_cosp*nhtmisr_cosp + real(r8) :: clisccp2(pcols,ntau_cosp,nprs_cosp) + real(r8) :: cfad_dbze94(pcols,CLOUDSAT_DBZE_BINS,nht_cosp) + real(r8) :: cfad_lidarsr532(pcols,nsr_cosp,nht_cosp) + real(r8) :: dbze94(pcols,nscol_cosp,nlay) + real(r8) :: atb532(pcols,nscol_cosp,nlay) + real(r8) :: clMISR(pcols,ntau_cosp,nhtmisr_cosp) + real(r8) :: frac_out(pcols,nscol_cosp,nlay) + real(r8) :: cldtot_isccp(pcols) + real(r8) :: meancldalb_isccp(pcols) + real(r8) :: meanptop_isccp(pcols) + real(r8) :: cldlow_cal(pcols) + real(r8) :: cldmed_cal(pcols) + real(r8) :: cldhgh_cal(pcols) + real(r8) :: cldtot_cal(pcols) + real(r8) :: cldtot_cal_ice(pcols) + real(r8) :: cldtot_cal_liq(pcols) + real(r8) :: cldtot_cal_un(pcols) + real(r8) :: cldhgh_cal_ice(pcols) + real(r8) :: cldhgh_cal_liq(pcols) + real(r8) :: cldhgh_cal_un(pcols) + real(r8) :: cldmed_cal_ice(pcols) + real(r8) :: cldmed_cal_liq(pcols) + real(r8) :: cldmed_cal_un(pcols) + real(r8) :: cldlow_cal_ice(pcols) + real(r8) :: cldlow_cal_liq(pcols) + real(r8) :: cldlow_cal_un(pcols) + real(r8) :: cld_cal(pcols,nht_cosp) + real(r8) :: cld_cal_liq(pcols,nht_cosp) + real(r8) :: cld_cal_ice(pcols,nht_cosp) + real(r8) :: cld_cal_un(pcols,nht_cosp) + real(r8) :: cld_cal_tmp(pcols,nht_cosp) + real(r8) :: cld_cal_tmpliq(pcols,nht_cosp) + real(r8) :: cld_cal_tmpice(pcols,nht_cosp) + real(r8) :: cld_cal_tmpun(pcols,nht_cosp) + real(r8) :: cfad_dbze94_cs(pcols,nht_cosp*CLOUDSAT_DBZE_BINS) + real(r8) :: cfad_sr532_cal(pcols,nht_cosp*nsr_cosp) + real(r8) :: tau_isccp(pcols,nscol_cosp) + real(r8) :: cldptop_isccp(pcols,nscol_cosp) + real(r8) :: meantau_isccp(pcols) + real(r8) :: meantb_isccp(pcols) + real(r8) :: meantbclr_isccp(pcols) + real(r8) :: dbze_cs(pcols,nlay*nscol_cosp) + real(r8) :: cldtot_calcs(pcols) + real(r8) :: cldtot_cs(pcols) + real(r8) :: cldtot_cs2(pcols) real(r8) :: ptcloudsatflag0(pcols) real(r8) :: ptcloudsatflag1(pcols) real(r8) :: ptcloudsatflag2(pcols) @@ -1516,12 +1271,12 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn real(r8) :: ptcloudsatflag8(pcols) real(r8) :: ptcloudsatflag9(pcols) real(r8) :: cloudsatpia(pcols) - real(r8) :: cld_cal_notcs(pcols,nht_cosp) ! CAM clcalipso2 (time,height,profile) - real(r8) :: atb532_cal(pcols,nhtml_cosp*nscol_cosp) ! CAM atb532 (time,height_mlev,column,profile) - real(r8) :: mol532_cal(pcols,nhtml_cosp) ! CAM beta_mol532 (time,height_mlev,profile) - real(r8) :: cld_misr(pcols,nhtmisr_cosp*ntau_cosp) ! CAM clMISR (time,tau,CTH_height_bin,profile) - real(r8) :: refl_parasol(pcols,nsza_cosp) ! CAM parasol_refl (time,sza,profile) - real(r8) :: scops_out(pcols,nhtml_cosp*nscol_cosp) ! CAM frac_out (time,height_mlev,column,profile) + real(r8) :: cld_cal_notcs(pcols,nht_cosp) + real(r8) :: atb532_cal(pcols,nlay*nscol_cosp) + real(r8) :: mol532_cal(pcols,nlay) + real(r8) :: cld_misr(pcols,nhtmisr_cosp*ntau_cosp) + real(r8) :: refl_parasol(pcols,nsza_cosp) + real(r8) :: scops_out(pcols,nlay*nscol_cosp) real(r8) :: cltmodis(pcols) real(r8) :: clwmodis(pcols) real(r8) :: climodis(pcols) @@ -1545,45 +1300,40 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn real(r8) :: clrimodis(pcols,ntau_cosp,numMODISReffIceBins) real(r8) :: clrlmodis_cam(pcols,ntau_cosp*numMODISReffLiqBins) real(r8) :: clrlmodis(pcols,ntau_cosp,numMODISReffLiqBins) - !real(r8) :: tau067_out(pcols,nhtml_cosp*nscol_cosp),emis11_out(pcols,nhtml_cosp*nscol_cosp) - real(r8),dimension(pcols,nhtml_cosp*nscol_cosp) :: & - tau067_out,emis11_out,fracliq_out,cal_betatot,cal_betatot_ice, & - cal_betatot_liq,cal_tautot,cal_tautot_ice,cal_tautot_liq,cs_gvol_out,cs_krvol_out,cs_zvol_out,& - asym34_out,ssa34_out + real(r8), dimension(pcols,nlay*nscol_cosp) :: & + tau067_out, emis11_out, fracliq_out, asym34_out, ssa34_out type(interp_type) :: interp_wgts - integer, parameter :: extrap_method = 1 ! sets extrapolation method to boundary value (1) + integer, parameter :: extrap_method = 1 ! sets extrapolation method to boundary value (1) ! COSPv2 stuff character(len=256),dimension(100) :: cosp_status integer :: nerror + integer :: istat + character(len=*), parameter :: sub = 'cospsimulator_intr_run' + !-------------------------------------------------------------------------------------- + call t_startf("init_and_stuff") ! ###################################################################################### ! Initialization ! ###################################################################################### - ! Find the chunk and ncol from the state vector - lchnk = state%lchnk ! state variable contains a number of columns, one chunk + + lchnk = state%lchnk ! chunk ID ncol = state%ncol ! number of columns in the chunk + Npoints = ncol ! number of COSP gridpoints zero_ifc = 0._r8 - ! Initialize temporary variables as R_UNDEF - need to do this otherwise array expansion puts garbage in history - ! file for columns over which COSP did make calculations. - tmp(1:pcols) = R_UNDEF - tmp1(1:pcols,1:pver) = R_UNDEF - tmp2(1:pcols,1:pver) = R_UNDEF - ! Initialize CAM variables as R_UNDEF, important for history files because it will exclude these from averages - ! (multi-dimensional output that will be collapsed) ! initialize over all pcols, not just ncol. missing values needed in chunks where ncol 0) then @@ -1824,218 +1533,133 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! CALCULATE COSP INPUT VARIABLES FROM CAM VARIABLES, done for all columns within chunk !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - ! 0) Create ptop/ztop for gbx%pf and gbx%zlev are for the the interface, - ! also reverse CAM height/pressure values for input into CSOP - ! CAM state%pint from top to surface, COSP wants surface to top. - - ! Initalize - ptop(1:ncol,1:pver)=0._r8 - pbot(1:ncol,1:pver)=0._r8 - ztop(1:ncol,1:pver)=0._r8 - zbot(1:ncol,1:pver)=0._r8 - zmid(1:ncol,1:pver)=0._r8 - - ! assign values from top - do k=1,pverp-1 - ! assign values from top - ptop(1:ncol,k)=state%pint(1:ncol,pverp-k) - ztop(1:ncol,k)=state%zi(1:ncol,pverp-k) - ! assign values from bottom - pbot(1:ncol,k)=state%pint(1:ncol,pverp-k+1) - zbot(1:ncol,k)=state%zi(1:ncol,pverp-k+1) - end do - - ! add surface height (surface geopotential/gravity) to convert CAM heights based on geopotential above surface into height above sea level - do k=1,pver - do i=1,ncol - ztop(i,k)=ztop(i,k)+state%phis(i)/gravit - zbot(i,k)=zbot(i,k)+state%phis(i)/gravit - zmid(i,k)=state%zm(i,k)+state%phis(i)/gravit - end do - end do - - ! 1) lat/lon - convert from radians to cosp input type - ! Initalize - lat_cosp(1:ncol)=0._r8 - lon_cosp(1:ncol)=0._r8 - ! convert from radians to degrees_north and degrees_east - lat_cosp=state%lat*180._r8/(pi) ! needs to go from -90 to +90 degrees north - lon_cosp=state%lon*180._r8/(pi) ! needs to go from 0 to 360 degrees east - - ! 2) rh - relative_humidity_liquid_water (%) - ! calculate from CAM q and t using CAM built-in functions - do k = 1, pver - call qsat_water(state%t(1:ncol,k), state%pmid(1:ncol,k), es(1:ncol,k), qs(1:ncol,k), ncol) - end do - ! initialize rh - rh(1:ncol,1:pver)=0._r8 - - ! calculate rh - do k=1,pver - do i=1,ncol - rh(i,k)=(q(i,k)/qs(i,k))*100 - end do + + ! These arrays are dimensioned to only include active columns (ncol), and the number + ! of layers (nlay) and layer interfaces (nlayp) operated on by COSP. + allocate( & + zmid(ncol,nlay), & + zint(ncol,nlayp), & + surf_hgt(ncol), & + landmask(ncol), & + mr_ccliq(ncol,nlay), & + mr_ccice(ncol,nlay), & + mr_lsliq(ncol,nlay), & + mr_lsice(ncol,nlay), & + rain_cv(ncol,nlayp), & + snow_cv(ncol,nlayp), & + rain_cv_interp(ncol,nlay), & + snow_cv_interp(ncol,nlay), & + rain_ls_interp(ncol,nlay), & + snow_ls_interp(ncol,nlay), & + grpl_ls_interp(ncol,nlay), & + reff_cosp(ncol,nlay,nhydro), & + dtau_s(ncol,nlay), & + dtau_c(ncol,nlay), & + dtau_s_snow(ncol,nlay), & + dem_s(ncol,nlay), & + dem_c(ncol,nlay), & + dem_s_snow(ncol,nlay), stat=istat) + call handle_allocate_error(istat, sub, 'zmid,..,dem_s_snow') + + ! add surface height (surface geopotential/gravity) to convert CAM heights based on + ! geopotential above surface into height above sea level + surf_hgt = state%phis(:ncol)*inverse_gravit + do k = 1, nlay + zmid(:,k) = state%zm(:ncol,ktop+k-1) + surf_hgt + zint(:,k) = state%zi(:ncol,ktop+k-1) + surf_hgt end do - - ! 3) landmask - calculate from cam_in%landfrac - ! initalize landmask - landmask(1:ncol)=0._r8 - ! calculate landmask - do i=1,ncol - if (cam_in%landfrac(i).gt.0.01_r8) landmask(i)= 1 + zint(:,nlayp) = surf_hgt + + landmask = 0._r8 + do i = 1, ncol + if (cam_in%landfrac(i) > 0.01_r8) landmask(i)= 1 end do - ! 4) calculate necessary input cloud/precip variables - ! CAM4 note: don't take the cloud water from the hack shallow convection scheme or the deep convection. - ! cloud water values for convection are the same as the stratiform value. (Sungsu) - ! all precip fluxes are mid points, all values are grid-box mean ("gbm") (Yuying) - - ! initialize local variables - mr_ccliq(1:ncol,1:pver) = 0._r8 - mr_ccice(1:ncol,1:pver) = 0._r8 - mr_lsliq(1:ncol,1:pver) = 0._r8 - mr_lsice(1:ncol,1:pver) = 0._r8 - grpl_ls_interp(1:ncol,1:pver) = 0._r8 - rain_ls_interp(1:ncol,1:pver) = 0._r8 - snow_ls_interp(1:ncol,1:pver) = 0._r8 - rain_cv(1:ncol,1:pverp) = 0._r8 - snow_cv(1:ncol,1:pverp) = 0._r8 - rain_cv_interp(1:ncol,1:pver) = 0._r8 - snow_cv_interp(1:ncol,1:pver) = 0._r8 - reff_cosp(1:ncol,1:pver,1:nhydro) = 0._r8 - ! note: reff_cosp dimensions should be same as cosp (reff_cosp has 9 hydrometeor dimension) - ! Reff(Npoints,Nlevels,N_HYDRO) - - use_precipitation_fluxes = .true. !!! consistent with cam4 implementation. - - ! add together deep and shallow convection precipitation fluxes, recall *_flxprc variables are rain+snow - rain_cv(1:ncol,1:pverp) = (sh_flxprc(1:ncol,1:pverp)-sh_flxsnw(1:ncol,1:pverp)) + & - (dp_flxprc(1:ncol,1:pverp)-dp_flxsnw(1:ncol,1:pverp)) - snow_cv(1:ncol,1:pverp) = sh_flxsnw(1:ncol,1:pverp) + dp_flxsnw(1:ncol,1:pverp) + ! Add together deep and shallow convection precipitation fluxes. + ! Note: sh_flxprc and dp_flxprc variables are rain+snow + rain_cv = (sh_flxprc(:ncol,ktop:pverp) - sh_flxsnw(:ncol,ktop:pverp)) + & + (dp_flxprc(:ncol,ktop:pverp) - dp_flxsnw(:ncol,ktop:pverp)) + snow_cv = sh_flxsnw(:ncol,ktop:pverp) + dp_flxsnw(:ncol,ktop:pverp) ! interpolate interface precip fluxes to mid points - do i=1,ncol - ! find weights (pressure weighting?) - call lininterp_init(state%zi(i,1:pverp),pverp,state%zm(i,1:pver),pver,extrap_method,interp_wgts) - ! interpolate lininterp1d(arrin, nin, arrout, nout, interp_wgts) - ! note: lininterp is an interface, contains lininterp1d -- code figures out to use lininterp1d. - call lininterp(rain_cv(i,1:pverp),pverp,rain_cv_interp(i,1:pver),pver,interp_wgts) - call lininterp(snow_cv(i,1:pverp),pverp,snow_cv_interp(i,1:pver),pver,interp_wgts) - call lininterp(ls_flxprc(i,1:pverp),pverp,rain_ls_interp(i,1:pver),pver,interp_wgts) - call lininterp(ls_flxsnw(i,1:pverp),pverp,snow_ls_interp(i,1:pver),pver,interp_wgts) + do i = 1, ncol + ! find weights + call lininterp_init(state%zi(i,ktop:pverp), nlayp, state%zm(i,ktop:pver), nlay, & + extrap_method, interp_wgts) + ! interpolate lininterp(arrin, nin, arrout, nout, interp_wgts) + call lininterp(rain_cv(i,:), nlayp, rain_cv_interp(i,:), nlay, interp_wgts) + call lininterp(snow_cv(i,:), nlayp, snow_cv_interp(i,:), nlay, interp_wgts) + call lininterp(ls_flxprc(i,ktop:pverp), nlayp, rain_ls_interp(i,:), nlay, interp_wgts) + call lininterp(ls_flxsnw(i,ktop:pverp), nlayp, snow_ls_interp(i,:), nlay, interp_wgts) call lininterp_finish(interp_wgts) !! ls_flxprc is for rain+snow, find rain_ls_interp by subtracting off snow_ls_interp - rain_ls_interp(i,1:pver)=rain_ls_interp(i,1:pver)-snow_ls_interp(i,1:pver) + rain_ls_interp(i,:) = rain_ls_interp(i,:) - snow_ls_interp(i,:) end do + + !! Make sure interpolated values are not less than 0 + do k = 1, nlay + do i = 1, ncol + if (rain_ls_interp(i,k) < 0._r8) then + rain_ls_interp(i,k) = 0._r8 + end if + if (snow_ls_interp(i,k) < 0._r8) then + snow_ls_interp(i,k) = 0._r8 + end if + if (rain_cv_interp(i,k) < 0._r8) then + rain_cv_interp(i,k) = 0._r8 + end if + if (snow_cv_interp(i,k) < 0._r8) then + snow_cv_interp(i,k) = 0._r8 + end if + end do + end do + + grpl_ls_interp = 0._r8 !! CAM5 cloud mixing ratio calculations !! Note: Although CAM5 has non-zero convective cloud mixing ratios that affect the model state, !! Convective cloud water is NOT part of radiation calculations. - do k=1,pver - do i=1,ncol - if (cld(i,k) .gt. 0._r8) then + mr_ccliq = 0._r8 + mr_ccice = 0._r8 + mr_lsliq = 0._r8 + mr_lsice = 0._r8 + do k = 1, nlay + kk = ktop + k -1 + do i = 1, ncol + if (cld(i,k) > 0._r8) then !! note: convective mixing ratio is the sum of shallow and deep convective clouds in CAM5 - mr_ccliq(i,k) = sh_cldliq(i,k) + dp_cldliq(i,k) - mr_ccice(i,k) = sh_cldice(i,k) + dp_cldice(i,k) - mr_lsliq(i,k)=state%q(i,k,ixcldliq) ! mr_lsliq, mixing_ratio_large_scale_cloud_liquid, state only includes stratiform (kg/kg) - mr_lsice(i,k)=state%q(i,k,ixcldice) ! mr_lsice - mixing_ratio_large_scale_cloud_ice, state only includes stratiform (kg/kg) - else - mr_ccliq(i,k) = 0._r8 - mr_ccice(i,k) = 0._r8 - mr_lsliq(i,k) = 0._r8 - mr_lsice(i,k) = 0._r8 + mr_ccliq(i,k) = sh_cldliq(i,kk) + dp_cldliq(i,kk) + mr_ccice(i,k) = sh_cldice(i,kk) + dp_cldice(i,kk) + mr_lsliq(i,k) = state%q(i,kk,ixcldliq) ! state only includes stratiform (kg/kg) + mr_lsice(i,k) = state%q(i,kk,ixcldice) ! state only includes stratiform (kg/kg) end if end do end do - !! Previously, I had set use_reff=.false. - !! use_reff = .false. !! if you use this,all sizes use DEFAULT_LIDAR_REFF = 30.0e-6 meters - - !! The specification of reff_cosp now follows e-mail discussion with Yuying in January 2011. (see above) - !! All of the values that I have assembled in the code are in microns... convert to meters here since that is what COSP wants. - use_reff = .true. - reff_cosp(1:ncol,1:pver,1) = rel(1:ncol,1:pver)*1.e-6_r8 !! LSCLIQ (same as effc and effliq in stratiform.F90) - reff_cosp(1:ncol,1:pver,2) = rei(1:ncol,1:pver)*1.e-6_r8 !! LSCICE (same as effi and effice in stratiform.F90) - reff_cosp(1:ncol,1:pver,3) = ls_reffrain(1:ncol,1:pver)*1.e-6_r8 !! LSRAIN (calculated in cldwat2m_micro.F90, passed to stratiform.F90) - reff_cosp(1:ncol,1:pver,4) = ls_reffsnow(1:ncol,1:pver)*1.e-6_r8 !! LSSNOW (calculated in cldwat2m_micro.F90, passed to stratiform.F90) - reff_cosp(1:ncol,1:pver,5) = cv_reffliq(1:ncol,1:pver)*1.e-6_r8 !! CVCLIQ (calculated in stratiform.F90, not actually used in radiation) - reff_cosp(1:ncol,1:pver,6) = cv_reffice(1:ncol,1:pver)*1.e-6_r8 !! CVCICE (calculated in stratiform.F90, not actually used in radiation) - reff_cosp(1:ncol,1:pver,7) = ls_reffrain(1:ncol,1:pver)*1.e-6_r8 !! CVRAIN (same as stratiform per Andrew) - reff_cosp(1:ncol,1:pver,8) = ls_reffsnow(1:ncol,1:pver)*1.e-6_r8 !! CVSNOW (same as stratiform per Andrew) - reff_cosp(1:ncol,1:pver,9) = 0._r8 !! LSGRPL (using radar default reff) + !! The specification of reff_cosp now follows e-mail discussion with Yuying in January 2011. + !! The values from the physics buffer are in microns... convert to meters for COSP. + reff_cosp(:,:,I_LSCLIQ) = rel(:ncol,ktop:pver)*1.e-6_r8 + reff_cosp(:,:,I_LSCICE) = rei(:ncol,ktop:pver)*1.e-6_r8 + reff_cosp(:,:,I_LSRAIN) = ls_reffrain(:ncol,ktop:pver)*1.e-6_r8 + reff_cosp(:,:,I_LSSNOW) = ls_reffsnow(:ncol,ktop:pver)*1.e-6_r8 + reff_cosp(:,:,I_CVCLIQ) = cv_reffliq(:ncol,ktop:pver)*1.e-6_r8 + reff_cosp(:,:,I_CVCICE) = cv_reffice(:ncol,ktop:pver)*1.e-6_r8 + reff_cosp(:,:,I_CVRAIN) = ls_reffrain(:ncol,ktop:pver)*1.e-6_r8 !! same as stratiform per Andrew + reff_cosp(:,:,I_CVSNOW) = ls_reffsnow(:ncol,ktop:pver)*1.e-6_r8 !! same as stratiform per Andrew + reff_cosp(:,:,I_LSGRPL) = 0._r8 !! using radar default reff - !! Need code below for when effective radius is fillvalue, and you multiply it by 1.e-6 to convert units, and value becomes no longer fillvalue. - !! Here, we set it back to zero. - where (rel(1:ncol,1:pver) .eq. R_UNDEF) - reff_cosp(1:ncol,1:pver,1) = 0._r8 - end where - where (rei(1:ncol,1:pver) .eq. R_UNDEF) - reff_cosp(1:ncol,1:pver,2) = 0._r8 - end where - where (ls_reffrain(1:ncol,1:pver) .eq. R_UNDEF) - reff_cosp(1:ncol,1:pver,3) = 0._r8 - end where - where (ls_reffsnow(1:ncol,1:pver) .eq. R_UNDEF) - reff_cosp(1:ncol,1:pver,4) = 0._r8 - end where - where (cv_reffliq(1:ncol,1:pver) .eq. R_UNDEF) - reff_cosp(1:ncol,1:pver,5) = 0._r8 - end where - where (cv_reffice(1:ncol,1:pver) .eq. R_UNDEF) - reff_cosp(1:ncol,1:pver,6) = 0._r8 - end where - where (ls_reffrain(1:ncol,1:pver) .eq. R_UNDEF) - reff_cosp(1:ncol,1:pver,7) = 0._r8 - end where - where (ls_reffsnow(1:ncol,1:pver) .eq. R_UNDEF) - reff_cosp(1:ncol,1:pver,8) = 0._r8 - end where - - !! Make sure interpolated values are not less than 0 - COSP was complaining and resetting small negative values to zero. - !! ----- WARNING: COSP_CHECK_INPUT_2D: minimum value of rain_ls set to: 0.000000000000000 - !! So I set negative values to zero here... - do k=1,pver - do i=1,ncol - if (rain_ls_interp(i,k) .lt. 0._r8) then - rain_ls_interp(i,k)=0._r8 - end if - if (snow_ls_interp(i,k) .lt. 0._r8) then - snow_ls_interp(i,k)=0._r8 - end if - if (rain_cv_interp(i,k) .lt. 0._r8) then - rain_cv_interp(i,k)=0._r8 - end if - if (snow_cv_interp(i,k) .lt. 0._r8) then - snow_cv_interp(i,k)=0._r8 - end if - end do - end do - - ! 5) assign optical depths and emissivities needed for isccp simulator - cld_swtau(1:ncol,1:pver) = cld_swtau_in(1:ncol,1:pver) - - ! initialize cosp inputs - dtau_s(1:ncol,1:pver) = 0._r8 - dtau_c(1:ncol,1:pver) = 0._r8 - dtau_s_snow(1:ncol,1:pver) = 0._r8 - dem_s(1:ncol,1:pver) = 0._r8 - dem_c(1:ncol,1:pver) = 0._r8 - dem_s_snow(1:ncol,1:pver) = 0._r8 - - ! assign values - ! NOTES: - ! 1) CAM4 assumes same radiative properties for stratiform and convective clouds, - ! (see ISCCP_CLOUD_TYPES subroutine call in cloudsimulator.F90) - ! I presume CAM5 is doing the same thing based on the ISCCP simulator calls within RRTM's radiation.F90 - ! 2) COSP wants in-cloud values. CAM5 values cld_swtau are in-cloud. - ! 3) snow_tau_in and snow_emis_in are passed without modification to COSP - dtau_s(1:ncol,1:pver) = cld_swtau(1:ncol,1:pver) ! mean 0.67 micron optical depth of stratiform (in-cloud) - dtau_c(1:ncol,1:pver) = cld_swtau(1:ncol,1:pver) ! mean 0.67 micron optical depth of convective (in-cloud) - dem_s(1:ncol,1:pver) = emis(1:ncol,1:pver) ! 10.5 micron longwave emissivity of stratiform (in-cloud) - dem_c(1:ncol,1:pver) = emis(1:ncol,1:pver) ! 10.5 micron longwave emissivity of convective (in-cloud) - dem_s_snow(1:ncol,1:pver) = snow_emis_in(1:ncol,1:pver) ! 10.5 micron grid-box mean optical depth of stratiform snow - dtau_s_snow(1:ncol,1:pver) = snow_tau_in(1:ncol,1:pver) ! 0.67 micron grid-box mean optical depth of stratiform snow + ! assign optical depths and emissivities + ! CAM4 assumes same radiative properties for stratiform and convective clouds, + ! (see ISCCP_CLOUD_TYPES subroutine call in cloudsimulator.F90) + ! Assume CAM5 is doing the same thing based on the ISCCP simulator calls within RRTM's radiation.F90 + ! COSP wants in-cloud values. CAM5 values cld_swtau are in-cloud. + ! snow_tau_in and snow_emis_in are passed without modification to COSP + dtau_s = cld_swtau_in(:ncol,ktop:pver) + dtau_c = cld_swtau_in(:ncol,ktop:pver) + dtau_s_snow = snow_tau_in(:ncol,ktop:pver) + dem_s = emis(:ncol,ktop:pver) + dem_c = emis(:ncol,ktop:pver) + dem_s_snow = snow_emis_in(:ncol,ktop:pver) ! ###################################################################################### ! Compute sunlit flag. If cosp_runall=.true., then run on all points. @@ -2044,32 +1668,22 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn if (cosp_runall) then cam_sunlit(:) = 1 nSunLit = ncol - nNoSunLit = 0 else nSunLit = 0 - nNoSunLit = 0 do i=1,ncol if ((coszrs(i) > 0.0_r8) .and. (run_cosp(i,lchnk))) then cam_sunlit(i) = 1 nSunLit = nSunLit+1 - else - nNoSunLit = nNoSunlit+1 endif enddo endif call t_stopf("init_and_stuff") - ! ###################################################################################### - ! ###################################################################################### - ! END TRANSLATE CAM VARIABLES TO COSP INPUT VARIABLES - ! ###################################################################################### - ! ###################################################################################### - ! ###################################################################################### ! Construct COSP output derived type. ! ###################################################################################### call t_startf("construct_cosp_outputs") - call construct_cosp_outputs(ncol,nscol_cosp,pver,Nlvgrid,0,cospOUT) + call construct_cosp_outputs(ncol, nscol_cosp, nlay, Nlvgrid, cospOUT) call t_stopf("construct_cosp_outputs") ! ###################################################################################### @@ -2077,44 +1691,45 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn ! ###################################################################################### ! Model state call t_startf("construct_cospstateIN") - call construct_cospstateIN(ncol,pver,0,cospstateIN) - cospstateIN%lat = lat_cosp(1:ncol) - cospstateIN%lon = lon_cosp(1:ncol) - cospstateIN%at = state%t(1:ncol,1:pver) - cospstateIN%qv = q(1:ncol,1:pver) - cospstateIN%o3 = o3(1:ncol,1:pver) - cospstateIN%sunlit = cam_sunlit(1:ncol) - cospstateIN%skt = cam_in%ts(1:ncol) - cospstateIN%land = landmask(1:ncol) - cospstateIN%pfull = state%pmid(1:ncol,1:pver) - cospstateIN%phalf(1:ncol,1) = 0._r8 - cospstateIN%phalf(1:ncol,2:pver+1) = pbot(1:ncol,pver:1:-1) - cospstateIN%hgt_matrix = zmid(1:ncol,1:pver) - cospstateIN%hgt_matrix_half(1:ncol,pver+1) = 0._r8 - cospstateIN%hgt_matrix_half(1:ncol,1:pver) = zbot(1:ncol,pver:1:-1) - cospstateIN%surfelev(1:ncol) = zbot(1:ncol,1) + + call construct_cospstateIN(ncol, nlay, 0, cospstateIN) + + ! convert to degrees. Lat in range [-90,..,90], Lon in range [0,..,360] + cospstateIN%lat = state%lat(:ncol)*rad2deg + cospstateIN%lon = state%lon(:ncol)*rad2deg + cospstateIN%at = state%t(:ncol,ktop:pver) + cospstateIN%qv = q(:ncol,ktop:pver) + cospstateIN%o3 = o3(:ncol,ktop:pver) + cospstateIN%sunlit = cam_sunlit(:ncol) + cospstateIN%skt = cam_in%ts(:ncol) + cospstateIN%land = landmask + cospstateIN%pfull = state%pmid(:ncol,ktop:pver) + cospstateIN%phalf = state%pint(:ncol,ktop:pverp) + cospstateIN%hgt_matrix = zmid + cospstateIN%hgt_matrix_half = zint + cospstateIN%surfelev = surf_hgt call t_stopf("construct_cospstateIN") ! Optical inputs call t_startf("construct_cospIN") - call construct_cospIN(ncol,nscol_cosp,pver,cospIN) - cospIN%emsfc_lw = emsfc_lw + call construct_cospIN(ncol, nscol_cosp, nlay, cospIN) + cospIN%emsfc_lw = emsfc_lw if (lradar_sim) cospIN%rcfg_cloudsat = rcfg_cs(lchnk) call t_stopf("construct_cospIN") - ! *NOTE* Fields passed into subsample_and_optics are ordered from TOA-2-SFC. call t_startf("subsample_and_optics") - call subsample_and_optics(ncol,pver,nscol_cosp,nhydro,overlap, & - use_precipitation_fluxes,lidar_ice_type,sd_cs(lchnk),cld(1:ncol,1:pver),& - concld(1:ncol,1:pver),rain_ls_interp(1:ncol,1:pver), & - snow_ls_interp(1:ncol,1:pver),grpl_ls_interp(1:ncol,1:pver), & - rain_cv_interp(1:ncol,1:pver),snow_cv_interp(1:ncol,1:pver), & - mr_lsliq(1:ncol,1:pver),mr_lsice(1:ncol,1:pver), & - mr_ccliq(1:ncol,1:pver),mr_ccice(1:ncol,1:pver), & - reff_cosp(1:ncol,1:pver,:),dtau_c(1:ncol,1:pver), & - dtau_s(1:ncol,1:pver),dem_c(1:ncol,1:pver), & - dem_s(1:ncol,1:pver),dtau_s_snow(1:ncol,1:pver), & - dem_s_snow(1:ncol,1:pver),state%ps(1:ncol),cospstateIN,cospIN) + ! The arrays passed here contain only active columns and the limited vertical + ! domain operated on by COSP. Unsubscripted array arguments have already been + ! allocated to the correct size. Arrays the size of a CAM chunk (pcol,pver) + ! need to pass the correct section (:ncol,ktop:pver). + call subsample_and_optics( & + ncol, nlay, nscol_cosp, nhydro, overlap, & + lidar_ice_type, sd_cs(lchnk), & + cld(:ncol,ktop:pver), concld(:ncol,ktop:pver), & + rain_ls_interp, snow_ls_interp, grpl_ls_interp, rain_cv_interp, & + snow_cv_interp, mr_lsliq, mr_lsice, mr_ccliq, mr_ccice, & + reff_cosp, dtau_c, dtau_s ,dem_c, dem_s, dtau_s_snow, & + dem_s_snow, state%ps(:ncol), cospstateIN, cospIN) call t_stopf("subsample_and_optics") ! ###################################################################################### @@ -2151,12 +1766,11 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn call outfld('ZLEV_COSP', cospstateIN%hgt_matrix, ncol,lchnk) call outfld('ZLEV_HALF_COSP', cospstateIN%hgt_matrix_half, ncol,lchnk) call outfld('T_COSP', cospstateIN%at, ncol,lchnk) - call outfld('RH_COSP', cospstateIN%qv, ncol,lchnk) - call outfld('Q_COSP', q(1:ncol,1:pver), ncol,lchnk) + call outfld('Q_COSP', cospstateIN%qv, ncol,lchnk) ! 3D outputs, but first compress to 2D do i=1,ncol - do ihml=1,nhtml_cosp + do ihml=1,nlay do isc=1,nscol_cosp ihsc = (ihml-1)*nscol_cosp+isc tau067_out(i,ihsc) = cospIN%tau_067(i,isc,ihml) @@ -2268,18 +1882,18 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn ! ###################################################################################### call t_startf("output_copying") if (allocated(cospIN%frac_out)) & - frac_out(1:ncol,1:nscol_cosp,1:nhtml_cosp) = cospIN%frac_out ! frac_out (time,height_mlev,column,profile) + frac_out(1:ncol,1:nscol_cosp,1:nlay) = cospIN%frac_out ! Cloudsat if (lradar_sim) then - cfad_dbze94(1:ncol,1:CLOUDSAT_DBZE_BINS,1:nht_cosp) = cospOUT%cloudsat_cfad_ze ! cfad_dbze94 (time,height,dbze,profile) - dbze94(1:ncol,1:nscol_cosp,1:nhtml_cosp) = cospOUT%cloudsat_Ze_tot ! dbze94 (time,height_mlev,column,profile) - cldtot_cs(1:ncol) = 0._r8!cospOUT%cloudsat_radar_tcc ! CAM version of cltradar (time,profile) ! NOT COMPUTED IN COSP2 - cldtot_cs2(1:ncol) = 0._r8!cospOUT%cloudsat_radar_tcc2 ! CAM version of cltradar2 (time,profile) ! NOT COMPUTED IN COSP2 + cfad_dbze94(1:ncol,1:CLOUDSAT_DBZE_BINS,1:nht_cosp) = cospOUT%cloudsat_cfad_ze + dbze94(1:ncol,1:nscol_cosp,1:nlay) = cospOUT%cloudsat_Ze_tot + cldtot_cs(1:ncol) = 0._r8 + cldtot_cs2(1:ncol) = 0._r8 ! *NOTE* These two fields are joint-simulator products, but in CAM they are controlled ! by the radar simulator control. - cldtot_calcs(1:ncol) = cospOUT%radar_lidar_tcc ! CAM version of cltlidarradar (time,profile) - cld_cal_notcs(1:ncol,1:nht_cosp) = cospOUT%lidar_only_freq_cloud ! CAM version of clcalipso2 (time,height,profile) + cldtot_calcs(1:ncol) = cospOUT%radar_lidar_tcc + cld_cal_notcs(1:ncol,1:nht_cosp) = cospOUT%lidar_only_freq_cloud ! Cloudsat near-surface precipitation diagnostics ptcloudsatflag0(1:ncol) = cospOUT%cloudsat_precip_cover(:,1) @@ -2294,81 +1908,56 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn ptcloudsatflag9(1:ncol) = cospOUT%cloudsat_precip_cover(:,10) cloudsatpia(1:ncol) = cospOUT%cloudsat_pia - ! Output the mixing-ratio for all hydrometeor types in Cloudsat near-surface precipitation diagnostics - ! *NOTE* These fields are simply the native CAM mixing-ratios for each hydrometeor type used in the - ! CAM6 microphysics scheme, interpolated to the same vertical grid used by the Cloudsat - ! simulator. These fields are not part of the radar simulator standard output, as these fields - ! are entirely dependent on the host models microphysics, not the retrieval. - - endif ! CALIPSO if (llidar_sim) then - cldlow_cal(1:ncol) = cospOUT%calipso_cldlayer(:,1) ! CAM version of cllcalipso (time,profile) - cldmed_cal(1:ncol) = cospOUT%calipso_cldlayer(:,2) ! CAM version of clmcalipso (time,profile) - cldhgh_cal(1:ncol) = cospOUT%calipso_cldlayer(:,3) ! CAM version of clhcalipso (time,profile) - cldtot_cal(1:ncol) = cospOUT%calipso_cldlayer(:,4) ! CAM version of cltcalipso (time,profile) - cldlow_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,1,1) ! CAM version of cllcalipsoice !+cosp1.4 - cldmed_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,2,1) ! CAM version of clmcalipsoice - cldhgh_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,3,1) ! CAM version of clhcalipsoice - cldtot_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,4,1) ! CAM version of cltcalipsoice - cldlow_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,1,2) ! CAM version of cllcalipsoliq - cldmed_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,2,2) ! CAM version of clmcalipsoliq - cldhgh_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,3,2) ! CAM version of clhcalipsoliq - cldtot_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,4,2) ! CAM version of cltcalipsoliq - cldlow_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,1,3) ! CAM version of cllcalipsoun - cldmed_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,2,3) ! CAM version of clmcalipsoun - cldhgh_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,3,3) ! CAM version of clhcalipsoun - cldtot_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,4,3) ! CAM version of cltcalipsoun, !+cosp1.4 - cld_cal_ice(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldphase(:,:,1) ! CAM version of clcalipsoice !+cosp1.4 - cld_cal_liq(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldphase(:,:,2) ! CAM version of clcalipsoliq - cld_cal_un(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldphase(:,:,3) ! CAM version of clcalipsoun - cld_cal_tmp(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,1) ! CAM version of clcalipsotmp - cld_cal_tmpliq(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,2) ! CAM version of clcalipsotmpice - cld_cal_tmpice(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,3) ! CAM version of clcalipsotmpliq - cld_cal_tmpun(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,4) ! CAM version of clcalipsotmpun, !+cosp1.4 - cld_cal(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcld(:,1:nht_cosp) ! CAM version of clcalipso (time,height,profile) - mol532_cal(1:ncol,1:nhtml_cosp) = cospOUT%calipso_beta_mol ! CAM version of beta_mol532 (time,height_mlev,profile) - atb532(1:ncol,1:nscol_cosp,1:nhtml_cosp) = cospOUT%calipso_beta_tot ! atb532 (time,height_mlev,column,profile) - cfad_lidarsr532(1:ncol,1:nsr_cosp,1:nht_cosp) = cospOUT%calipso_cfad_sr(:,:,:) ! cfad_lidarsr532 (time,height,scat_ratio,profile) - ! PARASOL. In COSP2, the Parasol simulator is independent of the calipso simulator. - refl_parasol(1:ncol,1:nsza_cosp) = cospOUT%parasolGrid_refl ! CAM version of parasolrefl (time,sza,profile) - ! CALIPSO Opaque cloud diagnostics -! cldopaq_cal(1:pcols) = cospOUT%calipso_cldtype(:,1) -! cldthin_cal(1:pcols) = cospOUT%calipso_cldtype(:,2) -! cldopaqz_cal(1:pcols) = cospOUT%calipso_cldtype(:,3) -! cldopaq_cal_temp(1:pcols) = cospOUT%calipso_cldtypetemp(:,1) -! cldthin_cal_temp(1:pcols) = cospOUT%calipso_cldtypetemp(:,2) -! cldzopaq_cal_temp(1:pcols) = cospOUT%calipso_cldtypetemp(:,3) -! cldopaq_cal_z(1:pcols) = cospOUT%calipso_cldtypemeanz(:,1) -! cldthin_cal_z(1:pcols) = cospOUT%calipso_cldtypemeanz(:,2) -! cldthin_cal_emis(1:pcols) = cospOUT%calipso_cldthinemis -! cldopaq_cal_se(1:pcols) = cospOUT%calipso_cldtypemeanzse(:,1) -! cldthin_cal_se(1:pcols) = cospOUT%calipso_cldtypemeanzse(:,2) -! cldzopaq_cal_se(1:pcols) = cospOUT%calipso_cldtypemeanzse(:,3) -! cldopaq_cal_2d(1:pcols,1:nht_cosp) = cospOUT%calipso_lidarcldtype(:,:,1) -! cldthin_cal_2d(1:pcols,1:nht_cosp) = cospOUT%calipso_lidarcldtype(:,:,2) -! cldzopaq_cal_2d(1:pcols,1:nht_cosp) = cospOUT%calipso_lidarcldtype(:,:,3) -! opacity_cal_2d(1:pcols,1:nht_cosp) = cospOUT%calipso_lidarcldtype(:,:,4) + cldlow_cal(1:ncol) = cospOUT%calipso_cldlayer(:,1) + cldmed_cal(1:ncol) = cospOUT%calipso_cldlayer(:,2) + cldhgh_cal(1:ncol) = cospOUT%calipso_cldlayer(:,3) + cldtot_cal(1:ncol) = cospOUT%calipso_cldlayer(:,4) + cldlow_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,1,1) + cldmed_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,2,1) + cldhgh_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,3,1) + cldtot_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,4,1) + cldlow_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,1,2) + cldmed_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,2,2) + cldhgh_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,3,2) + cldtot_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,4,2) + cldlow_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,1,3) + cldmed_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,2,3) + cldhgh_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,3,3) + cldtot_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,4,3) + cld_cal_ice(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldphase(:,:,1) + cld_cal_liq(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldphase(:,:,2) + cld_cal_un(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldphase(:,:,3) + cld_cal_tmp(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,1) + cld_cal_tmpliq(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,2) + cld_cal_tmpice(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,3) + cld_cal_tmpun(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,4) + cld_cal(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcld(:,1:nht_cosp) + mol532_cal(1:ncol,1:nlay) = cospOUT%calipso_beta_mol + atb532(1:ncol,1:nscol_cosp,1:nlay)= cospOUT%calipso_beta_tot + cfad_lidarsr532(1:ncol,1:nsr_cosp,1:nht_cosp) = cospOUT%calipso_cfad_sr(:,:,:) + refl_parasol(1:ncol,1:nsza_cosp) = cospOUT%parasolGrid_refl endif ! ISCCP if (lisccp_sim) then - clisccp2(1:ncol,1:ntau_cosp,1:nprs_cosp) = cospOUT%isccp_fq ! CAM version of clisccp2 (time,tau,plev,profile) - tau_isccp(1:ncol,1:nscol_cosp) = cospOUT%isccp_boxtau ! CAM version of boxtauisccp (time,column,profile) - cldptop_isccp(1:ncol,1:nscol_cosp) = cospOUT%isccp_boxptop ! CAM version of boxptopisccp (time,column,profile) - cldtot_isccp(1:ncol) = cospOUT%isccp_totalcldarea ! CAM version of tclisccp (time, profile) - meanptop_isccp(1:ncol) = cospOUT%isccp_meanptop ! CAM version of ctpisccp (time, profile) - meantau_isccp(1:ncol) = cospOUT%isccp_meantaucld ! CAM version of meantbisccp (time, profile) - meancldalb_isccp(1:ncol) = cospOUT%isccp_meanalbedocld ! CAM version of albisccp (time, profile) - meantb_isccp(1:ncol) = cospOUT%isccp_meantb ! CAM version of meantbisccp (time, profile) - meantbclr_isccp(1:ncol) = cospOUT%isccp_meantbclr ! CAM version of meantbclrisccp (time, profile) + clisccp2(1:ncol,1:ntau_cosp,1:nprs_cosp) = cospOUT%isccp_fq + tau_isccp(1:ncol,1:nscol_cosp) = cospOUT%isccp_boxtau + cldptop_isccp(1:ncol,1:nscol_cosp) = cospOUT%isccp_boxptop + cldtot_isccp(1:ncol) = cospOUT%isccp_totalcldarea + meanptop_isccp(1:ncol) = cospOUT%isccp_meanptop + meantau_isccp(1:ncol) = cospOUT%isccp_meantaucld + meancldalb_isccp(1:ncol) = cospOUT%isccp_meanalbedocld + meantb_isccp(1:ncol) = cospOUT%isccp_meantb + meantbclr_isccp(1:ncol) = cospOUT%isccp_meantbclr endif ! MISR if (lmisr_sim) then - clMISR(1:ncol,1:ntau_cosp,1:nhtmisr_cosp) = cospOUT%misr_fq ! CAM version of clMISR (time,tau,CTH_height_bin,profile) + clMISR(1:ncol,1:ntau_cosp,1:nhtmisr_cosp) = cospOUT%misr_fq endif ! MODIS @@ -2395,46 +1984,39 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn clrlmodis(1:ncol,1:ntau_cosp_modis,1:numMODISReffLiqBins) = cospOUT%modis_Optical_Thickness_vs_ReffLIQ endif - ! Use high-dimensional output to populate CAM collapsed output variables - ! see above for mixed dimension definitions - ! i am using the convention of starting vertical coordinates at the surface, up to down, COSP convention, not CAM. + ! Use COSP output to populate CAM collapsed output variables do i=1,ncol if (lradar_sim) then - ! CAM cfad_dbze94 (time,height,dbze,profile) do ih=1,nht_cosp do id=1,CLOUDSAT_DBZE_BINS ihd=(ih-1)*CLOUDSAT_DBZE_BINS+id - cfad_dbze94_cs(i,ihd) = cfad_dbze94(i,id,ih) ! cfad_dbze94_cs(pcols,nht_cosp*CLOUDSAT_DBZE_BINS) + cfad_dbze94_cs(i,ihd) = cfad_dbze94(i,id,ih) end do end do - ! CAM dbze94 (time,height_mlev,column,profile) - do ihml=1,nhtml_cosp + do ihml=1,nlay do isc=1,nscol_cosp ihsc=(ihml-1)*nscol_cosp+isc - dbze_cs(i,ihsc) = dbze94(i,isc,ihml) ! dbze_cs(pcols,pver*nscol_cosp) + dbze_cs(i,ihsc) = dbze94(i,isc,ihml) end do end do endif if (llidar_sim) then - ! CAM cfad_lidarsr532 (time,height,scat_ratio,profile) do ih=1,nht_cosp do is=1,nsr_cosp ihs=(ih-1)*nsr_cosp+is - cfad_sr532_cal(i,ihs) = cfad_lidarsr532(i,is,ih) ! cfad_sr532_cal(pcols,nht_cosp*nsr_cosp) + cfad_sr532_cal(i,ihs) = cfad_lidarsr532(i,is,ih) end do end do - ! CAM atb532 (time,height_mlev,column,profile) FIX - do ihml=1,nhtml_cosp + do ihml=1,nlay do isc=1,nscol_cosp ihsc=(ihml-1)*nscol_cosp+isc - atb532_cal(i,ihsc) = atb532(i,isc,ihml) ! atb532_cal(pcols,nht_cosp*nscol_cosp) + atb532_cal(i,ihsc) = atb532(i,isc,ihml) end do end do endif if (lmisr_sim) then - ! CAM clMISR (time,tau,CTH_height_bin,profile) do ihm=1,nhtmisr_cosp do it=1,ntau_cosp ihmt=(ihm-1)*ntau_cosp+it @@ -2444,21 +2026,18 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn endif if (lmodis_sim) then - ! CAM clmodis do ip=1,nprs_cosp do it=1,ntau_cosp_modis ipt=(ip-1)*ntau_cosp_modis+it clmodis_cam(i,ipt) = clmodis(i,it,ip) end do end do - ! CAM clrimodis do ip=1,numMODISReffIceBins do it=1,ntau_cosp_modis ipt=(ip-1)*ntau_cosp_modis+it clrimodis_cam(i,ipt) = clrimodis(i,it,ip) end do end do - ! CAM clrlmodis do ip=1,numMODISReffLiqBins do it=1,ntau_cosp_modis ipt=(ip-1)*ntau_cosp_modis+it @@ -2468,10 +2047,10 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn endif ! Subcolums - do ihml=1,nhtml_cosp + do ihml=1,nlay do isc=1,nscol_cosp ihsc=(ihml-1)*nscol_cosp+isc - scops_out(i,ihsc) = frac_out(i,isc,ihml) ! scops_out(pcols,nht_cosp*nscol_cosp) + scops_out(i,ihsc) = frac_out(i,isc,ihml) end do end do end do @@ -2601,40 +2180,6 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn end where call outfld('CLD_CAL_TMPUN',cld_cal_tmpun ,pcols,lchnk) !! !+cosp1.4 - ! Opaque cloud diagnostics -! call outfld('CLDOPQ_CAL', cldopaq_cal, pcols, lchnk) -! call outfld('CLDTHN_CAL', cldthin_cal, pcols, lchnk) -! call outfld('CLDZOPQ_CAL', cldopaqz_cal, pcols, lchnk) -! call outfld('CLDOPQ_CAL_TMP', cldopaq_cal_temp, pcols, lchnk) -! call outfld('CLDTHN_CAL_TMP', cldthin_cal_temp, pcols, lchnk) -! call outfld('CLDZOPQ_CAL_TMP', cldzopaq_cal_temp, pcols, lchnk) -! call outfld('CLDOPQ_CAL_Z', cldopaq_cal_z, pcols, lchnk) -! call outfld('CLDTHN_CAL_Z', cldthin_cal_z, pcols, lchnk) -! call outfld('CLDTHN_CAL_EMIS', cldthin_cal_emis, pcols, lchnk) -! call outfld('CLDOPQ_CAL_SE', cldopaq_cal_se, pcols, lchnk) -! call outfld('CLDTHN_CAL_SE', cldthin_cal_se, pcols, lchnk) -! call outfld('CLDZOPQ_CAL_SE', cldzopaq_cal_se, pcols, lchnk) -! ! -! where (cldopaq_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF) -! cldopaq_cal_2d(:ncol,:nht_cosp) = 0.0_r8 -! end where -! call outfld('CLDOPQ_CAL_2D', cldopaq_cal_2d, pcols, lchnk) -! ! -! where (cldthin_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF) -! cldthin_cal_2d(:ncol,:nht_cosp) = 0.0_r8 -! end where -! call outfld('CLDTHN_CAL_2D', cldthin_cal_2d, pcols, lchnk) -! ! -! where (cldzopaq_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF) -! cldzopaq_cal_2d(:ncol,:nht_cosp) = 0.0_r8 -! end where -! call outfld('CLDZOPQ_CAL_2D', cldzopaq_cal_2d, pcols, lchnk) -! ! -! where (opacity_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF) -! opacity_cal_2d(:ncol,:nht_cosp) = 0.0_r8 -! end where -! call outfld('OPACITY_CAL_2D', opacity_cal_2d, pcols, lchnk) - end if ! RADAR SIMULATOR OUTPUTS @@ -2794,7 +2339,7 @@ end subroutine cospsimulator_intr_run ! SUBROUTINE subsample_and_optics ! ###################################################################################### subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, & - use_precipitation_fluxes, lidar_ice_type, sd, tca, cca,& + lidar_ice_type, sd, tca, cca, & fl_lsrainIN, fl_lssnowIN, fl_lsgrplIN, fl_ccrainIN, & fl_ccsnowIN, mr_lsliq, mr_lsice, mr_ccliq, mr_ccice, & reffIN, dtau_c, dtau_s, dem_c, dem_s, dtau_s_snow, & @@ -2812,8 +2357,6 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, use mod_cosp_config, only: Nlvgrid, vgrid_zl, vgrid_zu use mod_cosp_stats, only: cosp_change_vertical_grid ! Inputs - logical,intent(in) :: & - use_precipitation_fluxes integer,intent(in) :: & nPoints, & ! Number of gridpoints nLevels, & ! Number of vertical levels @@ -2852,7 +2395,7 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, type(cosp_column_inputs),intent(inout) :: cospstateIN ! Local variables - integer :: i,j,k + integer :: i, j, k, istat real(wp),dimension(nPoints,nLevels) :: column_frac_out,column_prec_out, & fl_lsrain,fl_lssnow,fl_lsgrpl,fl_ccrain, & fl_ccsnow @@ -2870,6 +2413,9 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, MODIS_opticalThicknessIce, & fracPrecipIce, fracPrecipIce_statGrid real(wp),dimension(:,:,:,:),allocatable :: mr_hydro,Reff,Np + + character(len=*), parameter :: sub = 'subsample_and_optics' + !-------------------------------------------------------------------------------------- call t_startf("scops") if (Ncolumns .gt. 1) then @@ -2877,7 +2423,8 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, ! Generate subcolumns for clouds (SCOPS) and precipitation type (PREC_SCOPS) !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! RNG used for subcolumn generation - allocate(rngs(nPoints),seed(nPoints)) + allocate(rngs(nPoints), seed(nPoints), stat=istat) + call handle_allocate_error(istat, sub, 'rngs, seed') seed = int(sfcP) if (Npoints .gt. 1) seed=(sfcP-int(sfcP))*1000000 call init_rng(rngs, seed) @@ -2886,28 +2433,24 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, call scops(NPoints,Nlevels,Ncolumns,rngs,tca,cca,overlap,cospIN%frac_out,0) deallocate(seed,rngs) - ! Sum up precipitation rates. If not using preciitation fluxes, mixing ratios are - ! stored in _rate variables. - allocate(ls_p_rate(nPoints,nLevels),cv_p_rate(nPoints,Nlevels)) - if(use_precipitation_fluxes) then - ls_p_rate(:,1:nLevels) = fl_lsrainIN + fl_lssnowIN + fl_lsgrplIN - cv_p_rate(:,1:nLevels) = fl_ccrainIN + fl_ccsnowIN - else - ls_p_rate(:,1:nLevels) = 0 ! mixing_ratio(rain) + mixing_ratio(snow) + mixing_ratio (groupel) - cv_p_rate(:,1:nLevels) = 0 ! mixing_ratio(rain) + mixing_ratio(snow) - endif + ! Sum up precipitation rates. + allocate(ls_p_rate(nPoints,nLevels), cv_p_rate(nPoints,Nlevels), stat=istat) + call handle_allocate_error(istat, sub, 'ls_p_rate, cv_p_rate') + ls_p_rate(:,1:nLevels) = fl_lsrainIN + fl_lssnowIN + fl_lsgrplIN + cv_p_rate(:,1:nLevels) = fl_ccrainIN + fl_ccsnowIN ! Call PREC_SCOPS - allocate(frac_prec(nPoints,nColumns,nLevels)) + allocate(frac_prec(nPoints,nColumns,nLevels), stat=istat) + call handle_allocate_error(istat, sub, 'frac_prec') call prec_scops(nPoints,nLevels,nColumns,ls_p_rate,cv_p_rate,cospIN%frac_out,frac_prec) deallocate(ls_p_rate,cv_p_rate) !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Compute precipitation fraction in each gridbox !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ! Allocate - allocate(frac_ls(nPoints,nLevels),prec_ls(nPoints,nLevels), & - frac_cv(nPoints,nLevels),prec_cv(nPoints,nLevels)) + allocate(frac_ls(nPoints,nLevels),prec_ls(nPoints,nLevels), & + frac_cv(nPoints,nLevels),prec_cv(nPoints,nLevels), stat=istat) + call handle_allocate_error(istat, sub, 'frac_ls,..,prec_cv') ! Initialize frac_ls(1:nPoints,1:nLevels) = 0._wp @@ -2945,9 +2488,10 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, ! Compute mixing ratios, effective radii and precipitation fluxes for clouds ! and precipitation !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - allocate(mr_hydro(nPoints,nColumns,nLevels,nHydro), & - Reff(nPoints,nColumns,nLevels,nHydro), & - Np(nPoints,nColumns,nLevels,nHydro)) + allocate(mr_hydro(nPoints,nColumns,nLevels,nHydro), & + Reff(nPoints,nColumns,nLevels,nHydro), & + Np(nPoints,nColumns,nLevels,nHydro), stat=istat) + call handle_allocate_error(istat, sub, 'mr_hydro,Reff,Np') ! Initialize mr_hydro(:,:,:,:) = 0._wp @@ -3004,26 +2548,14 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, endif ! Precipitation - if (use_precipitation_fluxes) then - if (prec_ls(j,k) .ne. 0._r8) then - fl_lsrain(j,k) = fl_lsrainIN(j,k)/prec_ls(j,k) - fl_lssnow(j,k) = fl_lssnowIN(j,k)/prec_ls(j,k) - fl_lsgrpl(j,k) = fl_lsgrplIN(j,k)/prec_ls(j,k) - endif - if (prec_cv(j,k) .ne. 0._r8) then - fl_ccrain(j,k) = fl_ccrainIN(j,k)/prec_cv(j,k) - fl_ccsnow(j,k) = fl_ccsnowIN(j,k)/prec_cv(j,k) - endif - else - if (prec_ls(j,k) .ne. 0._r8) then - mr_hydro(j,:,k,I_LSRAIN) = mr_hydro(j,:,k,I_LSRAIN)/prec_ls(j,k) - mr_hydro(j,:,k,I_LSSNOW) = mr_hydro(j,:,k,I_LSSNOW)/prec_ls(j,k) - mr_hydro(j,:,k,I_LSGRPL) = mr_hydro(j,:,k,I_LSGRPL)/prec_ls(j,k) - endif - if (prec_cv(j,k) .ne. 0._r8) then - mr_hydro(j,:,k,I_CVRAIN) = mr_hydro(j,:,k,I_CVRAIN)/prec_cv(j,k) - mr_hydro(j,:,k,I_CVSNOW) = mr_hydro(j,:,k,I_CVSNOW)/prec_cv(j,k) - endif + if (prec_ls(j,k) .ne. 0._r8) then + fl_lsrain(j,k) = fl_lsrainIN(j,k)/prec_ls(j,k) + fl_lssnow(j,k) = fl_lssnowIN(j,k)/prec_ls(j,k) + fl_lsgrpl(j,k) = fl_lsgrplIN(j,k)/prec_ls(j,k) + endif + if (prec_cv(j,k) .ne. 0._r8) then + fl_ccrain(j,k) = fl_ccrainIN(j,k)/prec_cv(j,k) + fl_ccsnow(j,k) = fl_ccsnowIN(j,k)/prec_cv(j,k) endif enddo enddo @@ -3031,48 +2563,48 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Convert precipitation fluxes to mixing ratios !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - if (use_precipitation_fluxes) then - ! LS rain - call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & - cospstateIN%at, frac_prec, 1._wp, n_ax(I_LSRAIN), n_bx(I_LSRAIN), & - alpha_x(I_LSRAIN), c_x(I_LSRAIN), d_x(I_LSRAIN), g_x(I_LSRAIN), & - a_x(I_LSRAIN), b_x(I_LSRAIN), gamma_1(I_LSRAIN), gamma_2(I_LSRAIN), & - gamma_3(I_LSRAIN), gamma_4(I_LSRAIN), fl_lsrain, & - mr_hydro(:,:,:,I_LSRAIN), Reff(:,:,:,I_LSRAIN)) - ! LS snow - call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & - cospstateIN%at, frac_prec, 1._wp, n_ax(I_LSSNOW), n_bx(I_LSSNOW), & - alpha_x(I_LSSNOW), c_x(I_LSSNOW), d_x(I_LSSNOW), g_x(I_LSSNOW), & - a_x(I_LSSNOW), b_x(I_LSSNOW), gamma_1(I_LSSNOW), gamma_2(I_LSSNOW), & - gamma_3(I_LSSNOW), gamma_4(I_LSSNOW), fl_lssnow, & - mr_hydro(:,:,:,I_LSSNOW), Reff(:,:,:,I_LSSNOW)) - ! CV rain - call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & - cospstateIN%at, frac_prec, 2._wp, n_ax(I_CVRAIN), n_bx(I_CVRAIN), & - alpha_x(I_CVRAIN), c_x(I_CVRAIN), d_x(I_CVRAIN), g_x(I_CVRAIN), & - a_x(I_CVRAIN), b_x(I_CVRAIN), gamma_1(I_CVRAIN), gamma_2(I_CVRAIN), & - gamma_3(I_CVRAIN), gamma_4(I_CVRAIN), fl_ccrain, & - mr_hydro(:,:,:,I_CVRAIN), Reff(:,:,:,I_CVRAIN)) - ! CV snow - call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & - cospstateIN%at, frac_prec, 2._wp, n_ax(I_CVSNOW), n_bx(I_CVSNOW), & - alpha_x(I_CVSNOW), c_x(I_CVSNOW), d_x(I_CVSNOW), g_x(I_CVSNOW), & - a_x(I_CVSNOW), b_x(I_CVSNOW), gamma_1(I_CVSNOW), gamma_2(I_CVSNOW), & - gamma_3(I_CVSNOW), gamma_4(I_CVSNOW), fl_ccsnow, & - mr_hydro(:,:,:,I_CVSNOW), Reff(:,:,:,I_CVSNOW)) - ! LS groupel. - call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & - cospstateIN%at, frac_prec, 1._wp, n_ax(I_LSGRPL), n_bx(I_LSGRPL), & - alpha_x(I_LSGRPL), c_x(I_LSGRPL), d_x(I_LSGRPL), g_x(I_LSGRPL), & - a_x(I_LSGRPL), b_x(I_LSGRPL), gamma_1(I_LSGRPL), gamma_2(I_LSGRPL), & - gamma_3(I_LSGRPL), gamma_4(I_LSGRPL), fl_lsgrpl, & - mr_hydro(:,:,:,I_LSGRPL), Reff(:,:,:,I_LSGRPL)) - endif + + ! LS rain + call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & + cospstateIN%at, frac_prec, 1._wp, n_ax(I_LSRAIN), n_bx(I_LSRAIN), & + alpha_x(I_LSRAIN), c_x(I_LSRAIN), d_x(I_LSRAIN), g_x(I_LSRAIN), & + a_x(I_LSRAIN), b_x(I_LSRAIN), gamma_1(I_LSRAIN), gamma_2(I_LSRAIN), & + gamma_3(I_LSRAIN), gamma_4(I_LSRAIN), fl_lsrain, & + mr_hydro(:,:,:,I_LSRAIN), Reff(:,:,:,I_LSRAIN)) + ! LS snow + call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & + cospstateIN%at, frac_prec, 1._wp, n_ax(I_LSSNOW), n_bx(I_LSSNOW), & + alpha_x(I_LSSNOW), c_x(I_LSSNOW), d_x(I_LSSNOW), g_x(I_LSSNOW), & + a_x(I_LSSNOW), b_x(I_LSSNOW), gamma_1(I_LSSNOW), gamma_2(I_LSSNOW), & + gamma_3(I_LSSNOW), gamma_4(I_LSSNOW), fl_lssnow, & + mr_hydro(:,:,:,I_LSSNOW), Reff(:,:,:,I_LSSNOW)) + ! CV rain + call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & + cospstateIN%at, frac_prec, 2._wp, n_ax(I_CVRAIN), n_bx(I_CVRAIN), & + alpha_x(I_CVRAIN), c_x(I_CVRAIN), d_x(I_CVRAIN), g_x(I_CVRAIN), & + a_x(I_CVRAIN), b_x(I_CVRAIN), gamma_1(I_CVRAIN), gamma_2(I_CVRAIN), & + gamma_3(I_CVRAIN), gamma_4(I_CVRAIN), fl_ccrain, & + mr_hydro(:,:,:,I_CVRAIN), Reff(:,:,:,I_CVRAIN)) + ! CV snow + call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & + cospstateIN%at, frac_prec, 2._wp, n_ax(I_CVSNOW), n_bx(I_CVSNOW), & + alpha_x(I_CVSNOW), c_x(I_CVSNOW), d_x(I_CVSNOW), g_x(I_CVSNOW), & + a_x(I_CVSNOW), b_x(I_CVSNOW), gamma_1(I_CVSNOW), gamma_2(I_CVSNOW), & + gamma_3(I_CVSNOW), gamma_4(I_CVSNOW), fl_ccsnow, & + mr_hydro(:,:,:,I_CVSNOW), Reff(:,:,:,I_CVSNOW)) + ! LS groupel. + call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & + cospstateIN%at, frac_prec, 1._wp, n_ax(I_LSGRPL), n_bx(I_LSGRPL), & + alpha_x(I_LSGRPL), c_x(I_LSGRPL), d_x(I_LSGRPL), g_x(I_LSGRPL), & + a_x(I_LSGRPL), b_x(I_LSGRPL), gamma_1(I_LSGRPL), gamma_2(I_LSGRPL), & + gamma_3(I_LSGRPL), gamma_4(I_LSGRPL), fl_lsgrpl, & + mr_hydro(:,:,:,I_LSGRPL), Reff(:,:,:,I_LSGRPL)) else cospIN%frac_out(:,:,:) = 1 allocate(mr_hydro(nPoints, 1,nLevels,nHydro),Reff(nPoints,1,nLevels,nHydro), & - Np(nPoints,1,nLevels,nHydro)) + Np(nPoints,1,nLevels,nHydro), stat=istat) + call handle_allocate_error(istat, sub, 'mr_hydro,Reff,Np') mr_hydro(:,1,:,I_LSCLIQ) = mr_lsliq mr_hydro(:,1,:,I_LSCICE) = mr_lsice mr_hydro(:,1,:,I_CVCLIQ) = mr_ccliq @@ -3087,7 +2619,8 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, call t_startf("cloudsat_optics") if (lradar_sim) then ! Compute gaseous absorption (assume identical for each subcolun) - allocate(g_vol(nPoints,nLevels)) + allocate(g_vol(nPoints,nLevels), stat=istat) + call handle_allocate_error(istat, sub, 'g_vol') g_vol(:,:)=0._wp do i = 1, nPoints do j = 1, nLevels @@ -3101,7 +2634,8 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, end do ! Loop over all subcolumns - allocate(fracPrecipIce(nPoints,nColumns,nLevels)) + allocate(fracPrecipIce(nPoints,nColumns,nLevels), stat=istat) + call handle_allocate_error(istat, sub, 'fracPrecipIce') fracPrecipIce(:,:,:) = 0._wp do k=1,nColumns call quickbeam_optics(sd, cospIN%rcfg_cloudsat, nPoints, nLevels, R_UNDEF, & @@ -3124,7 +2658,8 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, enddo ! Regrid frozen fraction to Cloudsat/Calipso statistical grid - allocate(fracPrecipIce_statGrid(nPoints,nColumns,Nlvgrid)) + allocate(fracPrecipIce_statGrid(nPoints,nColumns,Nlvgrid), stat=istat) + call handle_allocate_error(istat, sub, 'fracPrecipIce_statGrid') fracPrecipIce_statGrid(:,:,:) = 0._wp call cosp_change_vertical_grid(Npoints, Ncolumns, Nlevels, cospstateIN%hgt_matrix(:,Nlevels:1:-1), & cospstateIN%hgt_matrix_half(:,Nlevels:1:-1), fracPrecipIce(:,:,Nlevels:1:-1), Nlvgrid, & @@ -3133,13 +2668,6 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, ! For near-surface diagnostics, we only need the frozen fraction at one layer. cospIN%fracPrecipIce(:,:) = fracPrecipIce_statGrid(:,:,cloudsat_preclvl) - ! Regrid preipitation mixing-ratios to statistical grid. - !allocate(tempStatGrid(nPoints,ncol,Nlvgrid)) - !tempStatGrid(:,:,:,:) = 0._wp - !call cosp_change_vertical_grid(Npoints, ncol, pver, cospstateIN%hgt_matrix(:,pver:1:-1), & - ! cospstateIN%hgt_matrix_half(:,pver:1:-1), mr_hydro(:,:,:,LSGRPL), & - ! Nlvgrid,vgrid_zl(Nlvgrid:1:-1), vgrid_zu(Nlvgrid:1:-1), tempStatGrid) - ! endif call t_stopf("cloudsat_optics") @@ -3228,7 +2756,8 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, MODIS_snowSize(nPoints,nColumns,nLevels), & MODIS_opticalThicknessLiq(nPoints,nColumns,nLevels), & MODIS_opticalThicknessIce(nPoints,nColumns,nLevels), & - MODIS_opticalThicknessSnow(nPoints,nColumns,nLevels)) + MODIS_opticalThicknessSnow(nPoints,nColumns,nLevels), stat=istat) + call handle_allocate_error(istat, sub, 'MODIS_*') ! Cloud water call cosp_simulator_optics(nPoints,nColumns,nLevels,cospIN%frac_out, & @@ -3284,6 +2813,11 @@ subroutine construct_cospIN(npoints,ncolumns,nlevels,y) nlevels ! Number of vertical levels ! Outputs type(cosp_optical_inputs),intent(out) :: y + + ! local + integer :: istat + character(len=*), parameter :: sub = 'construct_cospIN' + !-------------------------------------------------------------------------------------- ! Dimensions y%Npoints = Npoints @@ -3311,7 +2845,9 @@ subroutine construct_cospIN(npoints,ncolumns,nlevels,y) y%tau_mol_calipso( npoints, nlevels),& y%tautot_S_ice( npoints, ncolumns ),& y%tautot_S_liq( npoints, ncolumns) ,& - y%fracPrecipIce(npoints, ncolumns)) + y%fracPrecipIce(npoints, ncolumns), stat=istat) + call handle_allocate_error(istat, sub, 'tau_067,..,fracPrecipIce') + end subroutine construct_cospIN !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -3324,15 +2860,37 @@ subroutine construct_cospstateIN(npoints,nlevels,nchan,y) nlevels, & ! Number of vertical levels nchan ! Number of channels ! Outputs - type(cosp_column_inputs),intent(out) :: y - - allocate(y%sunlit(npoints),y%skt(npoints),y%land(npoints),y%at(npoints,nlevels), & - y%pfull(npoints,nlevels),y%phalf(npoints,nlevels+1),y%qv(npoints,nlevels), & - y%o3(npoints,nlevels),y%hgt_matrix(npoints,nlevels),y%u_sfc(npoints), & - y%v_sfc(npoints),y%lat(npoints),y%lon(nPoints),y%emis_sfc(nchan), & - y%cloudIce(nPoints,nLevels),y%cloudLiq(nPoints,nLevels),y%surfelev(nPoints),& - y%fl_snow(nPoints,nLevels),y%fl_rain(nPoints,nLevels),y%seaice(npoints), & - y%tca(nPoints,nLevels),y%hgt_matrix_half(npoints,nlevels+1)) + type(cosp_column_inputs),intent(out) :: y + + ! local + integer :: istat + character(len=*), parameter :: sub = 'construct_cospstateIN' + !-------------------------------------------------------------------------------------- + + allocate( & + y%sunlit(npoints), & + y%at(npoints,nlevels), & + y%pfull(npoints,nlevels), & + y%phalf(npoints,nlevels+1), & + y%qv(npoints,nlevels), & + y%hgt_matrix(npoints,nlevels), & + y%hgt_matrix_half(npoints,nlevels+1), & + y%land(npoints), & + y%skt(npoints), & + y%surfelev(nPoints), & + y%emis_sfc(nchan), & + y%u_sfc(npoints), & + y%v_sfc(npoints), & + y%seaice(npoints), & + y%lat(npoints), & + y%lon(nPoints), & + y%o3(npoints,nlevels), & + y%tca(nPoints,nLevels), & + y%cloudIce(nPoints,nLevels), & + y%cloudLiq(nPoints,nLevels), & + y%fl_rain(nPoints,nLevels), & + y%fl_snow(nPoints,nLevels), stat=istat) + call handle_allocate_error(istat, sub, 'sunlit,..,fl_snow') end subroutine construct_cospstateIN ! ###################################################################################### @@ -3340,106 +2898,114 @@ end subroutine construct_cospstateIN ! ! This subroutine allocates output fields based on input logical flag switches. ! ###################################################################################### - subroutine construct_cosp_outputs(Npoints,Ncolumns,Nlevels,Nlvgrid,Nchan,x) + subroutine construct_cosp_outputs(Npoints,Ncolumns,Nlevels,Nlvgrid,x) ! Inputs integer,intent(in) :: & Npoints, & ! Number of sampled points Ncolumns, & ! Number of subgrid columns Nlevels, & ! Number of model levels - Nlvgrid, & ! Number of levels in L3 stats computation - Nchan ! Number of RTTOV channels + Nlvgrid ! Number of levels in L3 stats computation ! Outputs type(cosp_outputs),intent(out) :: & x ! COSP output structure + + ! local + integer :: istat + character(len=*), parameter :: sub = 'construct_cosp_outputs' + !-------------------------------------------------------------------------------------- ! ISCCP simulator outputs if (lisccp_sim) then - allocate(x%isccp_boxtau(Npoints,Ncolumns)) - allocate(x%isccp_boxptop(Npoints,Ncolumns)) - allocate(x%isccp_fq(Npoints,numISCCPTauBins,numISCCPPresBins)) - allocate(x%isccp_totalcldarea(Npoints)) - allocate(x%isccp_meanptop(Npoints)) - allocate(x%isccp_meantaucld(Npoints)) - allocate(x%isccp_meantb(Npoints)) - allocate(x%isccp_meantbclr(Npoints)) - allocate(x%isccp_meanalbedocld(Npoints)) + allocate( & + x%isccp_boxtau(Npoints,Ncolumns), & + x%isccp_boxptop(Npoints,Ncolumns), & + x%isccp_fq(Npoints,numISCCPTauBins,numISCCPPresBins), & + x%isccp_totalcldarea(Npoints), & + x%isccp_meanptop(Npoints), & + x%isccp_meantaucld(Npoints), & + x%isccp_meantb(Npoints), & + x%isccp_meantbclr(Npoints), & + x%isccp_meanalbedocld(Npoints), stat=istat) + call handle_allocate_error(istat, sub, 'isccp_*') endif ! MISR simulator if (lmisr_sim) then - allocate(x%misr_fq(Npoints,numMISRTauBins,numMISRHgtBins)) - ! *NOTE* These 3 fields are not output, but were part of the v1.4.0 cosp_misr, so - ! they are still computed. Should probably have a logical to control these - ! outputs. - allocate(x%misr_dist_model_layertops(Npoints,numMISRHgtBins)) - allocate(x%misr_meanztop(Npoints)) - allocate(x%misr_cldarea(Npoints)) + allocate( & + x%misr_fq(Npoints,numMISRTauBins,numMISRHgtBins), & + ! *NOTE* These 3 fields are not output, but were part of the v1.4.0 cosp_misr, so + ! they are still computed. Should probably have a logical to control these + ! outputs. + x%misr_dist_model_layertops(Npoints,numMISRHgtBins), & + x%misr_meanztop(Npoints), & + x%misr_cldarea(Npoints), stat=istat) + call handle_allocate_error(istat, sub, 'misr_*') endif ! MODIS simulator if (lmodis_sim) then - allocate(x%modis_Cloud_Fraction_Total_Mean(Npoints)) - allocate(x%modis_Cloud_Fraction_Water_Mean(Npoints)) - allocate(x%modis_Cloud_Fraction_Ice_Mean(Npoints)) - allocate(x%modis_Cloud_Fraction_High_Mean(Npoints)) - allocate(x%modis_Cloud_Fraction_Mid_Mean(Npoints)) - allocate(x%modis_Cloud_Fraction_Low_Mean(Npoints)) - allocate(x%modis_Optical_Thickness_Total_Mean(Npoints)) - allocate(x%modis_Optical_Thickness_Water_Mean(Npoints)) - allocate(x%modis_Optical_Thickness_Ice_Mean(Npoints)) - allocate(x%modis_Optical_Thickness_Total_LogMean(Npoints)) - allocate(x%modis_Optical_Thickness_Water_LogMean(Npoints)) - allocate(x%modis_Optical_Thickness_Ice_LogMean(Npoints)) - allocate(x%modis_Cloud_Particle_Size_Water_Mean(Npoints)) - allocate(x%modis_Cloud_Particle_Size_Ice_Mean(Npoints)) - allocate(x%modis_Cloud_Top_Pressure_Total_Mean(Npoints)) - allocate(x%modis_Liquid_Water_Path_Mean(Npoints)) - allocate(x%modis_Ice_Water_Path_Mean(Npoints)) - allocate(x%modis_Optical_Thickness_vs_Cloud_Top_Pressure(nPoints,numModisTauBins,numMODISPresBins)) - allocate(x%modis_Optical_thickness_vs_ReffLIQ(nPoints,numMODISTauBins,numMODISReffLiqBins)) - allocate(x%modis_Optical_Thickness_vs_ReffICE(nPoints,numMODISTauBins,numMODISReffIceBins)) + allocate( & + x%modis_Cloud_Fraction_Total_Mean(Npoints), & + x%modis_Cloud_Fraction_Water_Mean(Npoints), & + x%modis_Cloud_Fraction_Ice_Mean(Npoints), & + x%modis_Cloud_Fraction_High_Mean(Npoints), & + x%modis_Cloud_Fraction_Mid_Mean(Npoints), & + x%modis_Cloud_Fraction_Low_Mean(Npoints), & + x%modis_Optical_Thickness_Total_Mean(Npoints), & + x%modis_Optical_Thickness_Water_Mean(Npoints), & + x%modis_Optical_Thickness_Ice_Mean(Npoints), & + x%modis_Optical_Thickness_Total_LogMean(Npoints), & + x%modis_Optical_Thickness_Water_LogMean(Npoints), & + x%modis_Optical_Thickness_Ice_LogMean(Npoints), & + x%modis_Cloud_Particle_Size_Water_Mean(Npoints), & + x%modis_Cloud_Particle_Size_Ice_Mean(Npoints), & + x%modis_Cloud_Top_Pressure_Total_Mean(Npoints), & + x%modis_Liquid_Water_Path_Mean(Npoints), & + x%modis_Ice_Water_Path_Mean(Npoints), & + x%modis_Optical_Thickness_vs_Cloud_Top_Pressure(nPoints,numModisTauBins,numMODISPresBins), & + x%modis_Optical_thickness_vs_ReffLIQ(nPoints,numMODISTauBins,numMODISReffLiqBins), & + x%modis_Optical_Thickness_vs_ReffICE(nPoints,numMODISTauBins,numMODISReffIceBins), & + stat=istat) + call handle_allocate_error(istat, sub, 'modis_*') endif ! CALIPSO simulator if (llidar_sim) then - allocate(x%calipso_beta_mol(Npoints,Nlevels)) - allocate(x%calipso_beta_tot(Npoints,Ncolumns,Nlevels)) - allocate(x%calipso_srbval(SR_BINS+1)) - allocate(x%calipso_cfad_sr(Npoints,SR_BINS,Nlvgrid)) - allocate(x%calipso_betaperp_tot(Npoints,Ncolumns,Nlevels)) - allocate(x%calipso_lidarcld(Npoints,Nlvgrid)) - allocate(x%calipso_cldlayer(Npoints,LIDAR_NCAT)) - allocate(x%calipso_lidarcldphase(Npoints,Nlvgrid,6)) - allocate(x%calipso_lidarcldtmp(Npoints,LIDAR_NTEMP,5)) - allocate(x%calipso_cldlayerphase(Npoints,LIDAR_NCAT,6)) - ! These 2 outputs are part of the calipso output type, but are not controlled by an - ! logical switch in the output namelist, so if all other fields are on, then allocate - allocate(x%calipso_tau_tot(Npoints,Ncolumns,Nlevels)) - allocate(x%calipso_temp_tot(Npoints,Nlevels)) - ! Calipso opaque cloud diagnostics -! allocate(x%calipso_cldtype(Npoints,LIDAR_NTYPE)) -! allocate(x%calipso_cldtypetemp(Npoints,LIDAR_NTYPE)) -! allocate(x%calipso_cldtypemeanz(Npoints,2)) -! allocate(x%calipso_cldtypemeanzse(Npoints,3)) -! allocate(x%calipso_cldthinemis(Npoints)) -! allocate(x%calipso_lidarcldtype(Npoints,Nlvgrid,LIDAR_NTYPE+1)) + allocate( & + x%calipso_beta_mol(Npoints,Nlevels), & + x%calipso_beta_tot(Npoints,Ncolumns,Nlevels), & + x%calipso_srbval(SR_BINS+1), & + x%calipso_cfad_sr(Npoints,SR_BINS,Nlvgrid), & + x%calipso_betaperp_tot(Npoints,Ncolumns,Nlevels), & + x%calipso_lidarcld(Npoints,Nlvgrid), & + x%calipso_cldlayer(Npoints,LIDAR_NCAT), & + x%calipso_lidarcldphase(Npoints,Nlvgrid,6), & + x%calipso_lidarcldtmp(Npoints,LIDAR_NTEMP,5), & + x%calipso_cldlayerphase(Npoints,LIDAR_NCAT,6), & + x%calipso_tau_tot(Npoints,Ncolumns,Nlevels), & + x%calipso_temp_tot(Npoints,Nlevels), stat=istat) + call handle_allocate_error(istat, sub, 'calipso_*') endif ! PARASOL if (lparasol_sim) then - allocate(x%parasolPix_refl(Npoints,Ncolumns,PARASOL_NREFL)) - allocate(x%parasolGrid_refl(Npoints,PARASOL_NREFL)) + allocate( & + x%parasolPix_refl(Npoints,Ncolumns,PARASOL_NREFL), & + x%parasolGrid_refl(Npoints,PARASOL_NREFL), stat=istat) + call handle_allocate_error(istat, sub, 'parasol*') endif ! Cloudsat simulator if (lradar_sim) then - allocate(x%cloudsat_Ze_tot(Npoints,Ncolumns,Nlevels)) - allocate(x%cloudsat_cfad_ze(Npoints,CLOUDSAT_DBZE_BINS,Nlvgrid)) - allocate(x%lidar_only_freq_cloud(Npoints,Nlvgrid)) - allocate(x%radar_lidar_tcc(Npoints)) - allocate(x%cloudsat_precip_cover(Npoints,nCloudsatPrecipClass)) - allocate(x%cloudsat_pia(Npoints)) + allocate( & + x%cloudsat_Ze_tot(Npoints,Ncolumns,Nlevels), & + x%cloudsat_cfad_ze(Npoints,CLOUDSAT_DBZE_BINS,Nlvgrid), & + x%lidar_only_freq_cloud(Npoints,Nlvgrid), & + x%radar_lidar_tcc(Npoints), & + x%cloudsat_precip_cover(Npoints,nCloudsatPrecipClass), & + x%cloudsat_pia(Npoints), stat=istat) + call handle_allocate_error(istat, sub, 'cloudsat*') endif end subroutine construct_cosp_outputs diff --git a/src/physics/cam/gw_drag.F90 b/src/physics/cam/gw_drag.F90 index 0f48e661af..aeab27a5c6 100644 --- a/src/physics/cam/gw_drag.F90 +++ b/src/physics/cam/gw_drag.F90 @@ -28,6 +28,8 @@ module gw_drag use cam_history, only: outfld use cam_logfile, only: iulog use cam_abortutils, only: endrun + use error_messages, only: alloc_err + use ref_pres, only: do_molec_diff, nbot_molec, press_lim_idx use physconst, only: cpair @@ -35,10 +37,11 @@ module gw_drag ! These are the actual switches for different gravity wave sources. use phys_control, only: use_gw_oro, use_gw_front, use_gw_front_igw, & use_gw_convect_dp, use_gw_convect_sh, & - use_simple_phys + use_simple_phys, use_gw_movmtn_pbl use gw_common, only: GWBand use gw_convect, only: BeresSourceDesc + use gw_movmtn, only: MovMtnSourceDesc use gw_front, only: CMSourceDesc ! Typical module header @@ -64,6 +67,8 @@ module gw_drag type(GWBand) :: band_mid ! Long scale waves for IGWs. type(GWBand) :: band_long + ! Medium scale waves for moving mountain + type(GWBand) :: band_movmtn ! Top level for gravity waves. integer, parameter :: ktop = 1 @@ -129,13 +134,17 @@ module gw_drag logical :: gw_apply_tndmax = .true. ! Files to read Beres source spectra from. - character(len=256) :: gw_drag_file = "" - character(len=256) :: gw_drag_file_sh = "" + character(len=cl) :: gw_drag_file = "" + character(len=cl) :: gw_drag_file_sh = "" + character(len=cl) :: gw_drag_file_mm = "" ! Beres settings and table. type(BeresSourceDesc) :: beres_dp_desc type(BeresSourceDesc) :: beres_sh_desc + ! Moving mountain settings and table. + type(MovMtnSourceDesc) :: movmtn_desc + ! Frontogenesis wave settings. type(CMSourceDesc) :: cm_desc type(CMSourceDesc) :: cm_igw_desc @@ -148,6 +157,13 @@ module gw_drag integer :: frontga_idx = -1 integer :: sgh_idx = -1 + ! From CLUBB + integer :: ttend_clubb_idx = -1 + integer :: upwp_clubb_gw_idx = -1 + integer :: vpwp_clubb_gw_idx = -1 + integer :: thlp2_clubb_gw_idx = -1 + integer :: wpthlp_clubb_gw_idx = -1 + ! anisotropic ridge fields integer, parameter :: prdg = 16 @@ -186,9 +202,11 @@ module gw_drag real(r8) :: gw_prndl = 0.25_r8 real(r8) :: gw_qbo_hdepth_scaling = 1._r8 ! heating depth scaling factor - ! Width of gaussian used to create frontogenesis tau profile [m/s]. + ! Width of gaussian used to create frontogenesis tau profile [m s-1]. real(r8) :: front_gaussian_width = -huge(1._r8) + real(r8) :: alpha_gw_movmtn + logical :: gw_top_taper=.false. real(r8), pointer :: vramp(:)=>null() @@ -224,7 +242,7 @@ subroutine gw_drag_readnl(nlfile) namelist /gw_drag_nl/ pgwv, gw_dc, pgwv_long, gw_dc_long, tau_0_ubc, & effgw_beres_dp, effgw_beres_sh, effgw_cm, effgw_cm_igw, effgw_oro, & - fcrit2, frontgfc, gw_drag_file, gw_drag_file_sh, taubgnd, & + fcrit2, frontgfc, gw_drag_file, gw_drag_file_sh, gw_drag_file_mm, taubgnd, & taubgnd_igw, gw_polar_taper, & use_gw_rdg_beta, n_rdg_beta, effgw_rdg_beta, effgw_rdg_beta_max, & rdg_beta_cd_llb, trpd_leewv_rdg_beta, & @@ -232,7 +250,7 @@ subroutine gw_drag_readnl(nlfile) rdg_gamma_cd_llb, trpd_leewv_rdg_gamma, bnd_rdggm, & gw_oro_south_fac, gw_limit_tau_without_eff, & gw_lndscl_sgh, gw_prndl, gw_apply_tndmax, gw_qbo_hdepth_scaling, & - gw_top_taper, front_gaussian_width + gw_top_taper, front_gaussian_width, alpha_gw_movmtn !---------------------------------------------------------------------- if (use_simple_phys) return @@ -332,10 +350,15 @@ subroutine gw_drag_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: gw_drag_file") call mpi_bcast(gw_drag_file_sh, len(gw_drag_file_sh), mpi_character, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: gw_drag_file_sh") + call mpi_bcast(gw_drag_file_mm, len(gw_drag_file_mm), mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: gw_drag_file_mm") call mpi_bcast(front_gaussian_width, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: front_gaussian_width") + call mpi_bcast(alpha_gw_movmtn, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: alpha_gw_movmtn") + ! Check if fcrit2 was set. call shr_assert(fcrit2 /= unset_r8, & "gw_drag_readnl: fcrit2 must be set via the namelist."// & @@ -355,6 +378,7 @@ subroutine gw_drag_readnl(nlfile) band_oro = GWBand(0, gw_dc, fcrit2, wavelength_mid) band_mid = GWBand(pgwv, gw_dc, 1.0_r8, wavelength_mid) band_long = GWBand(pgwv_long, gw_dc_long, 1.0_r8, wavelength_long) + band_movmtn = GWBand(0, gw_dc, 1.0_r8, wavelength_mid) if (use_gw_rdg_gamma .or. use_gw_rdg_beta) then call gw_rdg_readnl(nlfile) @@ -468,14 +492,14 @@ subroutine gw_init() integer :: grid_id character(len=8) :: dim1name, dim2name logical :: found - character(len=256) :: bnd_rdggm_loc ! filepath of topo file on local disk + character(len=cl) :: bnd_rdggm_loc ! filepath of topo file on local disk ! Allow reporting of error messages. character(len=128) :: errstring character(len=*), parameter :: sub = 'gw_init' ! temporary workaround for restart w/ ridge scheme - character(len=256) :: bnd_topo_loc ! filepath of topo file on local disk + character(len=cl) :: bnd_topo_loc ! filepath of topo file on local disk integer :: botndx,topndx @@ -506,7 +530,7 @@ subroutine gw_init() end if ! pre-calculated newtonian damping: - ! * convert to 1/s + ! * convert to s-1 ! * ensure it is not smaller than 1e-6 ! * convert palph from hpa to pa @@ -549,7 +573,7 @@ subroutine gw_init() if ( use_gw_oro ) then if (effgw_oro == unset_r8) then - call endrun("gw_drag_init: Orographic gravity waves enabled, & + call endrun("gw_init: Orographic gravity waves enabled, & &but effgw_oro was not set.") end if end if @@ -559,22 +583,22 @@ subroutine gw_init() sgh_idx = pbuf_get_index('SGH') ! Declare history variables for orographic term - call addfld ('TAUAORO', (/ 'ilev' /), 'I','N/m2', & + call addfld ('TAUAORO', (/ 'ilev' /), 'I','N m-2', & 'Total stress from original OGW scheme') - call addfld ('TTGWORO', (/ 'lev' /), 'A','K/s', & + call addfld ('TTGWORO', (/ 'lev' /), 'A','K s-1', & 'T tendency - orographic gravity wave drag') - call addfld ('TTGWSDFORO', (/ 'lev' /), 'A','K/s', & + call addfld ('TTGWSDFORO', (/ 'lev' /), 'A','K s-1', & 'T tendency - orographic gravity wave, diffusion.') - call addfld ('TTGWSKEORO', (/ 'lev' /), 'A','K/s', & + call addfld ('TTGWSKEORO', (/ 'lev' /), 'A','K s-1', & 'T tendency - orographic gravity wave, breaking KE.') - call addfld ('UTGWORO', (/ 'lev' /), 'A','m/s2', & + call addfld ('UTGWORO', (/ 'lev' /), 'A','m s-2', & 'U tendency - orographic gravity wave drag') - call addfld ('VTGWORO', (/ 'lev' /), 'A','m/s2', & + call addfld ('VTGWORO', (/ 'lev' /), 'A','m s-2', & 'V tendency - orographic gravity wave drag') call register_vector_field('UTGWORO', 'VTGWORO') - call addfld ('TAUGWX', horiz_only, 'A','N/m2', & + call addfld ('TAUGWX', horiz_only, 'A','N m-2', & 'Zonal gravity wave surface stress') - call addfld ('TAUGWY', horiz_only, 'A','N/m2', & + call addfld ('TAUGWY', horiz_only, 'A','N m-2', & 'Meridional gravity wave surface stress') call register_vector_field('TAUGWX', 'TAUGWY') @@ -698,9 +722,9 @@ subroutine gw_init() call addfld ('Frx_DIAG', horiz_only, 'I','1', & 'Obstacle Froude Number') - call addfld('UEGW', (/ 'lev' /) , 'A' ,'1/s' , & + call addfld('UEGW', (/ 'lev' /) , 'A' ,'s-1' , & 'Zonal wind profile-entry to GW ' ) - call addfld('VEGW', (/ 'lev' /) , 'A' ,'1/s' , & + call addfld('VEGW', (/ 'lev' /) , 'A' ,'s-1' , & 'Merdional wind profile-entry to GW ' ) call register_vector_field('UEGW','VEGW') call addfld('TEGW', (/ 'lev' /) , 'A' ,'K' , & @@ -710,32 +734,32 @@ subroutine gw_init() call addfld('ZMGW', (/ 'lev' /) , 'A' ,'m' , & 'midlayer geopotential heights in GW code ' ) - call addfld('TAUM1_DIAG' , (/ 'ilev' /) , 'I' ,'N/m2' , & + call addfld('TAUM1_DIAG' , (/ 'ilev' /) , 'I' ,'N m-2' , & 'Ridge based momentum flux profile') - call addfld('TAU1RDGBETAM' , (/ 'ilev' /) , 'I' ,'N/m2' , & + call addfld('TAU1RDGBETAM' , (/ 'ilev' /) , 'I' ,'N m-2' , & 'Ridge based momentum flux profile') - call addfld('UBM1BETA', (/ 'lev' /) , 'A' ,'1/s' , & + call addfld('UBM1BETA', (/ 'lev' /) , 'A' ,'s-1' , & 'On-ridge wind profile ' ) - call addfld('UBT1RDGBETA' , (/ 'lev' /) , 'I' ,'m/s' , & + call addfld('UBT1RDGBETA' , (/ 'lev' /) , 'I' ,'m s-1' , & 'On-ridge wind tendency from ridge 1 ') do i = 1, 6 write(cn, '(i1)') i - call addfld('TAU'//cn//'RDGBETAY' , (/ 'ilev' /), 'I', 'N/m2', & + call addfld('TAU'//cn//'RDGBETAY' , (/ 'ilev' /), 'I', 'N m-2', & 'Ridge based momentum flux profile') - call addfld('TAU'//cn//'RDGBETAX' , (/ 'ilev' /), 'I', 'N/m2', & + call addfld('TAU'//cn//'RDGBETAX' , (/ 'ilev' /), 'I', 'N m-2', & 'Ridge based momentum flux profile') call register_vector_field('TAU'//cn//'RDGBETAX','TAU'//cn//'RDGBETAY') - call addfld('UT'//cn//'RDGBETA', (/ 'lev' /), 'I', 'm/s', & + call addfld('UT'//cn//'RDGBETA', (/ 'lev' /), 'I', 'm s-1', & 'U wind tendency from ridge '//cn) - call addfld('VT'//cn//'RDGBETA', (/ 'lev' /), 'I', 'm/s', & + call addfld('VT'//cn//'RDGBETA', (/ 'lev' /), 'I', 'm s-1', & 'V wind tendency from ridge '//cn) call register_vector_field('UT'//cn//'RDGBETA','VT'//cn//'RDGBETA') end do - call addfld('TAUARDGBETAY' , (/ 'ilev' /) , 'I' ,'N/m2' , & + call addfld('TAUARDGBETAY' , (/ 'ilev' /) , 'I' ,'N m-2' , & 'Ridge based momentum flux profile') - call addfld('TAUARDGBETAX' , (/ 'ilev' /) , 'I' ,'N/m2' , & + call addfld('TAUARDGBETAX' , (/ 'ilev' /) , 'I' ,'N m-2' , & 'Ridge based momentum flux profile') call register_vector_field('TAUARDGBETAX','TAUARDGBETAY') @@ -798,39 +822,39 @@ subroutine gw_init() call pio_closefile(fh_rdggm) - call addfld ('TAU1RDGGAMMAM' , (/ 'ilev' /) , 'I' ,'N/m2' , & + call addfld ('TAU1RDGGAMMAM' , (/ 'ilev' /) , 'I' ,'N m-2' , & 'Ridge based momentum flux profile') - call addfld ('UBM1GAMMA', (/ 'lev' /) , 'A' ,'1/s' , & + call addfld ('UBM1GAMMA', (/ 'lev' /) , 'A' ,'s-1' , & 'On-ridge wind profile ' ) - call addfld ('UBT1RDGGAMMA' , (/ 'lev' /) , 'I' ,'m/s' , & + call addfld ('UBT1RDGGAMMA' , (/ 'lev' /) , 'I' ,'m s-1' , & 'On-ridge wind tendency from ridge 1 ') do i = 1, 6 write(cn, '(i1)') i - call addfld('TAU'//cn//'RDGGAMMAY', (/ 'ilev' /), 'I', 'N/m2', & + call addfld('TAU'//cn//'RDGGAMMAY', (/ 'ilev' /), 'I', 'N m-2', & 'Ridge based momentum flux profile') - call addfld('TAU'//cn//'RDGGAMMAX', (/ 'ilev' /), 'I', 'N/m2', & + call addfld('TAU'//cn//'RDGGAMMAX', (/ 'ilev' /), 'I', 'N m-2', & 'Ridge based momentum flux profile') - call addfld('UT'//cn//'RDGGAMMA' , (/ 'lev' /), 'I', 'm/s', & + call addfld('UT'//cn//'RDGGAMMA' , (/ 'lev' /), 'I', 'm s-1', & 'U wind tendency from ridge '//cn) - call addfld('VT'//cn//'RDGGAMMA' , (/ 'lev' /), 'I', 'm/s', & + call addfld('VT'//cn//'RDGGAMMA' , (/ 'lev' /), 'I', 'm s-1', & 'V wind tendency from ridge '//cn) call register_vector_field('UT'//cn//'RDGGAMMA','VT'//cn//'RDGGAMMA') end do - call addfld ('TAUARDGGAMMAY' , (/ 'ilev' /) , 'I' ,'N/m2' , & + call addfld ('TAUARDGGAMMAY' , (/ 'ilev' /) , 'I' ,'N m-2' , & 'Ridge based momentum flux profile') - call addfld ('TAUARDGGAMMAX' , (/ 'ilev' /) , 'I' ,'N/m2' , & + call addfld ('TAUARDGGAMMAX' , (/ 'ilev' /) , 'I' ,'N m-2' , & 'Ridge based momentum flux profile') call register_vector_field('TAUARDGGAMMAX','TAUARDGGAMMAY') - call addfld ('TAURDGGMX', horiz_only, 'A','N/m2', & + call addfld ('TAURDGGMX', horiz_only, 'A','N m-2', & 'Zonal gravity wave surface stress') - call addfld ('TAURDGGMY', horiz_only, 'A','N/m2', & + call addfld ('TAURDGGMY', horiz_only, 'A','N m-2', & 'Meridional gravity wave surface stress') call register_vector_field('TAURDGGMX','TAURDGGMY') - call addfld ('UTRDGGM' , (/ 'lev' /) , 'I' ,'m/s' , & + call addfld ('UTRDGGM' , (/ 'lev' /) , 'I' ,'m s-1' , & 'U wind tendency from ridge 6 ') - call addfld ('VTRDGGM' , (/ 'lev' /) , 'I' ,'m/s' , & + call addfld ('VTRDGGM' , (/ 'lev' /) , 'I' ,'m s-1' , & 'V wind tendency from ridge 6 ') call register_vector_field('UTRDGGM','VTRDGGM') end if @@ -841,7 +865,7 @@ subroutine gw_init() frontga_idx = pbuf_get_index('FRONTGA') call shr_assert(unset_r8 /= frontgfc, & - "gw_drag_init: Frontogenesis enabled, but frontgfc was & + "gw_init: Frontogenesis enabled, but frontgfc was & & not set!"// & errMsg(__FILE__, __LINE__)) @@ -874,7 +898,7 @@ subroutine gw_init() if (use_gw_front) then call shr_assert(all(unset_r8 /= [ effgw_cm, taubgnd ]), & - "gw_drag_init: Frontogenesis mid-scale waves enabled, but not & + "gw_init: Frontogenesis mid-scale waves enabled, but not & &all required namelist variables were set!"// & errMsg(__FILE__, __LINE__)) @@ -896,7 +920,7 @@ subroutine gw_init() if (use_gw_front_igw) then call shr_assert(all(unset_r8 /= [ effgw_cm_igw, taubgnd_igw ]), & - "gw_drag_init: Frontogenesis inertial waves enabled, but not & + "gw_init: Frontogenesis inertial waves enabled, but not & &all required namelist variables were set!"// & errMsg(__FILE__, __LINE__)) @@ -915,6 +939,87 @@ subroutine gw_init() end if + ! ========= Moving Mountain initialization! ========================== + if (use_gw_movmtn_pbl) then + + ! get pbuf indices for CLUBB couplings + ttend_clubb_idx = pbuf_get_index('TTEND_CLUBB') + thlp2_clubb_gw_idx = pbuf_get_index('THLP2_CLUBB_GW') + upwp_clubb_gw_idx = pbuf_get_index('UPWP_CLUBB_GW') + vpwp_clubb_gw_idx = pbuf_get_index('VPWP_CLUBB_GW') + wpthlp_clubb_gw_idx = pbuf_get_index('WPTHLP_CLUBB_GW') + + if (masterproc) then + write (iulog,*) 'Moving Mountain development code call init_movmtn' + end if + + + ! Confirm moving mountain file is enabled + call shr_assert(trim(gw_drag_file_mm) /= "", & + "gw_init: No gw_drag_file provided for DP GW moving mountain lookup & + &table. Set this via namelist."// & + errMsg(__FILE__, __LINE__)) + + call gw_init_movmtn(gw_drag_file_mm, band_movmtn, movmtn_desc) + + do k = 0, pver + ! 950 hPa index + if (pref_edge(k+1) < 95000._r8) movmtn_desc%k = k+1 + end do + + ! Don't use deep convection heating depths below this limit. + movmtn_desc%min_hdepth = 1._r8 + if (masterproc) then + write (iulog,*) 'Moving mountain deep level =',movmtn_desc%k + end if + + call addfld ('GWUT_MOVMTN',(/ 'lev' /), 'I','m s-2', & + 'Mov Mtn dragforce - ubm component') + call addfld ('UTGW_MOVMTN',(/ 'lev' /), 'I','m s-2', & + 'Mov Mtn dragforce - u component') + call addfld ('VTGW_MOVMTN',(/ 'lev' /), 'I','m s-2', & + 'Mov Mtn dragforce - v component') + call addfld('TAU_MOVMTN', (/ 'ilev' /), 'I', 'N m-2', & + 'Moving Mountain momentum flux profile') + call addfld('U_MOVMTN_IN', (/ 'lev' /), 'I', 'm s-1', & + 'Moving Mountain - midpoint zonal input wind') + call addfld('V_MOVMTN_IN', (/ 'lev' /), 'I', 'm s-1', & + 'Moving Mountain - midpoint meridional input wind') + call addfld('UBI_MOVMTN', (/ 'ilev' /), 'I', 'm s-1', & + 'Moving Mountain - interface wind in direction of wave') + call addfld('UBM_MOVMTN', (/ 'lev' /), 'I', 'm s-1', & + 'Moving Mountain - midpoint wind in direction of wave') + call addfld ('HDEPTH_MOVMTN',horiz_only,'I','km', & + 'Heating Depth') + call addfld ('UCELL_MOVMTN',horiz_only,'I','m s-1', & + 'Gravity Wave Moving Mountain - Source-level X-wind') + call addfld ('VCELL_MOVMTN',horiz_only,'I','m s-1', & + 'Gravity Wave Moving Mountain - Source-level Y-wind') + call addfld ('CS_MOVMTN',horiz_only,'I','m s-1', & + 'Gravity Wave Moving Mountain - phase speed in direction of wave') + call addfld ('STEER_LEVEL_MOVMTN',horiz_only,'I','1', & + 'Gravity Wave Moving Mountain - steering level for movmtn GW') + call addfld ('SRC_LEVEL_MOVMTN',horiz_only,'I','1', & + 'Gravity Wave Moving Mountain - launch level for movmtn GW') + call addfld ('TND_LEVEL_MOVMTN',horiz_only,'I','1', & + 'Gravity Wave Moving Mountain - tendency lowest level for movmtn GW') + call addfld ('NETDT_MOVMTN',(/ 'lev' /),'I','K s-1', & + 'Gravity Wave Moving Mountain - Net heating rate') + call addfld ('TTEND_CLUBB',(/ 'lev' /),'A','K s-1', & + 'Gravity Wave Moving Mountain - CLUBB Net heating rate') + call addfld ('THLP2_CLUBB_GW',(/ 'ilev' /),'A','K+2', & + 'Gravity Wave Moving Mountain - THLP variance from CLUBB to GW') + call addfld ('WPTHLP_CLUBB_GW',(/ 'ilev' /),'A','Km s-2', & + 'Gravity Wave Moving Mountain - WPTHLP from CLUBB to GW') + call addfld ('UPWP_CLUBB_GW',(/ 'ilev' /),'A','m+2 s-2', & + 'Gravity Wave Moving Mountain - X-momflux from CLUBB to GW') + call addfld ('VPWP_CLUBB_GW',(/ 'ilev' /),'A','m+2 s-2', & + 'Gravity Wave Moving Mountain - Y-momflux from CLUBB to GW') + call addfld ('XPWP_SRC_MOVMTN',horiz_only,'I','m+2 s-2', & + 'Gravity Wave Moving Mountain - flux source for moving mtn') + + end if + if (use_gw_convect_dp) then ttend_dp_idx = pbuf_get_index('TTEND_DP') @@ -938,7 +1043,7 @@ subroutine gw_init() ! Read Beres file. call shr_assert(trim(gw_drag_file) /= "", & - "gw_drag_init: No gw_drag_file provided for Beres deep & + "gw_init: No gw_drag_file provided for Beres deep & &scheme. Set this via namelist."// & errMsg(__FILE__, __LINE__)) @@ -948,9 +1053,9 @@ subroutine gw_init() call gw_spec_addflds(prefix=beres_dp_pf, scheme="Beres (deep)", & band=band_mid, history_defaults=history_waccm) - call addfld ('NETDT',(/ 'lev' /), 'A','K/s', & + call addfld ('NETDT',(/ 'lev' /), 'A','K s-1', & 'Net heating rate') - call addfld ('MAXQ0',horiz_only , 'A','K/day', & + call addfld ('MAXQ0',horiz_only , 'A','K day-1', & 'Max column heating rate') call addfld ('HDEPTH',horiz_only, 'A','km', & 'Heating Depth') @@ -985,7 +1090,7 @@ subroutine gw_init() ! Read Beres file. call shr_assert(trim(gw_drag_file_sh) /= "", & - "gw_drag_init: No gw_drag_file_sh provided for Beres shallow & + "gw_init: No gw_drag_file_sh provided for Beres shallow & &scheme. Set this via namelist."// & errMsg(__FILE__, __LINE__)) @@ -995,9 +1100,9 @@ subroutine gw_init() call gw_spec_addflds(prefix=beres_sh_pf, scheme="Beres (shallow)", & band=band_mid, history_defaults=history_waccm) - call addfld ('SNETDT',(/ 'lev' /), 'A','K/s', & + call addfld ('SNETDT',(/ 'lev' /), 'A','K s-1', & 'Net heating rate') - call addfld ('SMAXQ0',horiz_only , 'A','K/day', & + call addfld ('SMAXQ0',horiz_only , 'A','K day-1', & 'Max column heating rate') call addfld ('SHDEPTH',horiz_only, 'A','km', & 'Heating Depth') @@ -1017,14 +1122,14 @@ subroutine gw_init() call add_default('EKGW', 1, ' ') end if - call addfld ('UTGW_TOTAL', (/ 'lev' /), 'A','m/s2', & + call addfld ('UTGW_TOTAL', (/ 'lev' /), 'A','m s-2', & 'Total U tendency due to gravity wave drag') - call addfld ('VTGW_TOTAL', (/ 'lev' /), 'A','m/s2', & + call addfld ('VTGW_TOTAL', (/ 'lev' /), 'A','m s-2', & 'Total V tendency due to gravity wave drag') call register_vector_field('UTGW_TOTAL', 'VTGW_TOTAL') ! Total temperature tendency output. - call addfld ('TTGW', (/ 'lev' /), 'A', 'K/s', & + call addfld ('TTGW', (/ 'lev' /), 'A', 'K s-1', & 'T tendency - gravity wave drag') ! Water budget terms. @@ -1089,9 +1194,9 @@ subroutine gw_init_beres(file_name, band, desc) integer :: ngwv_file ! Full path to gw_drag_file. - character(len=256) :: file_path + character(len=cl) :: file_path - character(len=256) :: msg + character(len=cl) :: msg !---------------------------------------------------------------------- ! read in look-up table for source spectra @@ -1117,8 +1222,8 @@ subroutine gw_init_beres(file_name, band, desc) ngwv_file = (ngwv_file-1)/2 call shr_assert(ngwv_file >= band%ngwv, & - "gw_beres_init: PS in lookup table file does not cover the whole & - &spectrum implied by the model's ngwv.") + "gw_init_beres: PhaseSpeed in lookup table file does not cover the whole & + &spectrum implied by the model's ngwv. ") ! Allocate hd and get data. @@ -1179,6 +1284,134 @@ subroutine gw_init_beres(file_name, band, desc) end subroutine gw_init_beres +!============================================================== +subroutine gw_init_movmtn(file_name, band, desc) + + use ioFileMod, only: getfil + use pio, only: file_desc_t, pio_nowrite, pio_inq_varid, pio_get_var, & + pio_closefile + use cam_pio_utils, only: cam_pio_openfile + + character(len=*), intent(in) :: file_name + type(GWBand), intent(in) :: band + + type(MovMtnSourceDesc), intent(inout) :: desc + + type(file_desc_t) :: gw_file_desc + + ! PIO variable ids and error code. + integer :: mfccid, uhid, hdid, stat + + ! Number of wavenumbers in the input file. + integer :: ngwv_file + + ! Full path to gw_drag_file. + character(len=cl) :: file_path + + character(len=cl) :: msg + + !---------------------------------------------------------------------- + ! read in look-up table for source spectra + !----------------------------------------------------------------------- + + call getfil(file_name, file_path) + + call cam_pio_openfile(gw_file_desc, file_path, pio_nowrite) + + ! Get HD (heating depth) dimension. + + desc%maxh = 15 !get_pio_dimlen(gw_file_desc, "HD", file_path) + + ! Get MW (mean wind) dimension. + + desc%maxuh = 241 ! get_pio_dimlen(gw_file_desc, "MW", file_path) + + ! Get PS (phase speed) dimension. + + ngwv_file = 0 !get_pio_dimlen(gw_file_desc, "PS", file_path) + + ! Number in each direction is half of total (and minus phase speed of 0). + desc%maxuh = (desc%maxuh-1)/2 + ngwv_file = (ngwv_file-1)/2 + + call shr_assert(ngwv_file >= band%ngwv, & + "gw_movmtn_init: PhaseSpeed in lookup table inconsistent with moving mountain") + + ! Allocate hd and get data. + + allocate(desc%hd(desc%maxh), stat=stat, errmsg=msg) + + call shr_assert(stat == 0, & + "gw_init_movmtn: Allocation error (hd): "//msg// & + errMsg(__FILE__, __LINE__)) + + stat = pio_inq_varid(gw_file_desc,'HDEPTH',hdid) + + call handle_pio_error(stat, & + 'Error finding HD in: '//trim(file_path)) + + stat = pio_get_var(gw_file_desc, hdid, start=[1], count=[desc%maxh], & + ival=desc%hd) + + call handle_pio_error(stat, & + 'Error reading HD from: '//trim(file_path)) + + ! While not currently documented in the file, it uses kilometers. Convert + ! to meters. + desc%hd = desc%hd*1000._r8 + + ! Allocate wind and get data. + + allocate(desc%uh(desc%maxuh), stat=stat, errmsg=msg) + + call shr_assert(stat == 0, & + "gw_init_movmtn: Allocation error (uh): "//msg// & + errMsg(__FILE__, __LINE__)) + + stat = pio_inq_varid(gw_file_desc,'UARR',uhid) + + call handle_pio_error(stat, & + 'Error finding UH in: '//trim(file_path)) + + stat = pio_get_var(gw_file_desc, uhid, start=[1], count=[desc%maxuh], & + ival=desc%uh) + + call handle_pio_error(stat, & + 'Error reading UH from: '//trim(file_path)) + + ! Allocate mfcc. "desc%maxh" and "desc%maxuh" are from the file, but the + ! model determines wavenumber dimension. + + allocate(desc%mfcc(desc%maxh,-desc%maxuh:desc%maxuh,& + -band%ngwv:band%ngwv), stat=stat, errmsg=msg) + + call shr_assert(stat == 0, & + "gw_init_movmtn: Allocation error (mfcc): "//msg// & + errMsg(__FILE__, __LINE__)) + + ! Get mfcc data. + + stat = pio_inq_varid(gw_file_desc,'NEWMF',mfccid) + + call handle_pio_error(stat, & + 'Error finding mfcc in: '//trim(file_path)) + + stat = pio_get_var(gw_file_desc, mfccid, & + start=[1,1], count=shape(desc%mfcc), & + ival=desc%mfcc) + + call handle_pio_error(stat, & + 'Error reading mfcc from: '//trim(file_path)) + + call pio_closefile(gw_file_desc) + + if (masterproc) then + + write(iulog,*) "Read in Mov Mountain source file." + + endif + +end subroutine gw_init_movmtn !========================================================================== ! Utility to reduce the repetitiveness of reads during initialization. @@ -1244,6 +1477,7 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) use gw_oro, only: gw_oro_src use gw_front, only: gw_cm_src use gw_convect, only: gw_beres_src + use gw_movmtn, only: gw_movmtn_src !------------------------------Arguments-------------------------------- type(physics_state), intent(in) :: state ! physics state structure @@ -1260,6 +1494,7 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) integer :: lchnk ! chunk identifier integer :: ncol ! number of atmospheric columns + integer :: istat integer :: i, k ! loop indices @@ -1294,7 +1529,7 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) real(r8) :: dttke(state%ncol,pver) ! Wave phase speeds for each column - real(r8), allocatable :: c(:,:) + real(r8), allocatable :: phase_speeds(:,:) ! Efficiency for a gravity wave source. real(r8) :: effgw(state%ncol) @@ -1319,6 +1554,15 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Temperature change due to shallow convection. real(r8), pointer :: ttend_sh(:,:) + ! New couplings from CLUBB + real(r8), pointer :: ttend_clubb(:,:) + real(r8), pointer :: thlp2_clubb_gw(:,:) + real(r8), pointer :: wpthlp_clubb_gw(:,:) + real(r8), pointer :: upwp_clubb_gw(:,:) + real(r8), pointer :: vpwp_clubb_gw(:,:) + real(r8) :: xpwp_clubb(state%ncol,pver+1) + + ! Standard deviation of orography. real(r8), pointer :: sgh(:) @@ -1390,13 +1634,14 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) real(r8) :: piln(state%ncol,pver+1) real(r8) :: zm(state%ncol,pver) real(r8) :: zi(state%ncol,pver+1) + !------------------------------------------------------------------------ ! Make local copy of input state. call physics_state_copy(state, state1) ! constituents are all treated as wet mmr - call set_dry_to_wet(state1) + call set_dry_to_wet(state1, convert_cnst_type='dry') lchnk = state1%lchnk ncol = state1%ncol @@ -1454,15 +1699,111 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) egwdffi_tot = 0._r8 flx_heat = 0._r8 + if (use_gw_movmtn_pbl) then + !------------------------------------------------------------------ + !Convective moving mountain gravity waves (Beres scheme). + !------------------------------------------------------------------ + + call outfld('U_MOVMTN_IN', u, ncol, lchnk) + call outfld('V_MOVMTN_IN', v, ncol, lchnk) + + ! Allocate wavenumber fields. + allocate(tau(ncol,-band_movmtn%ngwv:band_movmtn%ngwv,pver+1),stat=istat) + call alloc_err(istat,'gw_tend','tau',ncol*(band_movmtn%ngwv**2+1)*(pver+1)) + allocate(gwut(ncol,pver,-band_movmtn%ngwv:band_movmtn%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','gwut',ncol*pver*band_movmtn%ngwv**2+1) + allocate(phase_speeds(ncol,-band_movmtn%ngwv:band_movmtn%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','phase_speeds',ncol*band_movmtn%ngwv**2+1) + + ! Set up heating + call pbuf_get_field(pbuf, ttend_dp_idx, ttend_dp) + + ! New couplings from CLUBB + call pbuf_get_field(pbuf, ttend_clubb_idx, ttend_clubb) + call pbuf_get_field(pbuf, thlp2_clubb_gw_idx, thlp2_clubb_gw) + call pbuf_get_field(pbuf, wpthlp_clubb_gw_idx, wpthlp_clubb_gw) + call pbuf_get_field(pbuf, upwp_clubb_gw_idx, upwp_clubb_gw) + call pbuf_get_field(pbuf, vpwp_clubb_gw_idx, vpwp_clubb_gw) + + xpwp_clubb(:ncol,:) = sqrt( upwp_clubb_gw(:ncol,:)**2 + vpwp_clubb_gw(:ncol,:)**2 ) + + effgw = 1._r8 + call gw_movmtn_src(ncol, lchnk, band_movmtn , movmtn_desc, & + u, v, ttend_dp(:ncol,:), ttend_clubb(:ncol,:), xpwp_clubb(:ncol,:) , & + zm, alpha_gw_movmtn, src_level, tend_level, & + tau, ubm, ubi, xv, yv, & + phase_speeds, hdepth) + !------------------------------------------------------------- + ! gw_movmtn_src returns wave-relative wind profiles ubm,ubi + ! and unit vector components describing direction of wavevector + ! and application of wave-drag force. I believe correct setting + ! for c is c=0, since it is incorporated in ubm and (xv,yv) + !-------------------------------------------------------------- + + call outfld('SRC_LEVEL_MOVMTN', real(src_level,r8), ncol, lchnk) + call outfld('TND_LEVEL_MOVMTN', real(tend_level,r8), ncol, lchnk) + call outfld('UBI_MOVMTN', ubi, ncol, lchnk) + call outfld('UBM_MOVMTN', ubm, ncol, lchnk) + + call gw_drag_prof(ncol, band_movmtn, p, src_level, tend_level, dt, & + t, vramp, & + piln, rhoi, nm, ni, ubm, ubi, xv, yv, & + effgw, phase_speeds, kvtt, q, dse, tau, utgw, vtgw, & + ttgw, qtgw, egwdffi, gwut, dttdf, dttke, & + lapply_effgw_in=gw_apply_tndmax ) + + ! Project stress into directional components. + taucd = calc_taucd(ncol, band_movmtn%ngwv, tend_level, tau, phase_speeds, xv, yv, ubi) + + ! add the diffusion coefficients + do k = 1, pver+1 + egwdffi_tot(:,k) = egwdffi_tot(:,k) + egwdffi(:,k) + end do + + ! Store constituents tendencies + do m=1, pcnst + do k = 1, pver + ptend%q(:ncol,k,m) = ptend%q(:ncol,k,m) + qtgw(:,k,m) + end do + end do + + ! Add the momentum tendencies to the output tendency arrays. + do k = 1, pver + ptend%u(:ncol,k) = ptend%u(:ncol,k) + utgw(:,k) + ptend%v(:ncol,k) = ptend%v(:ncol,k) + vtgw(:,k) + end do + + do k = 1, pver + ptend%s(:ncol,k) = ptend%s(:ncol,k) + ttgw(:,k) + end do + + call outfld('TAU_MOVMTN', tau(:,0,:), ncol, lchnk) + call outfld('GWUT_MOVMTN', gwut(:,:,0), ncol, lchnk) + call outfld('VTGW_MOVMTN', vtgw, ncol, lchnk) + call outfld('UTGW_MOVMTN', utgw, ncol, lchnk) + call outfld('HDEPTH_MOVMTN', hdepth/1000._r8, ncol, lchnk) + call outfld('NETDT_MOVMTN', ttend_dp, pcols, lchnk) + call outfld('TTEND_CLUBB', ttend_clubb, pcols, lchnk) + call outfld('THLP2_CLUBB_GW', thlp2_clubb_gw, pcols, lchnk) + call outfld('WPTHLP_CLUBB_GW', wpthlp_clubb_gw, pcols, lchnk) + call outfld('UPWP_CLUBB_GW', upwp_clubb_gw, pcols, lchnk) + call outfld('VPWP_CLUBB_GW', vpwp_clubb_gw, pcols, lchnk) + + deallocate(tau, gwut, phase_speeds) + end if + if (use_gw_convect_dp) then !------------------------------------------------------------------ ! Convective gravity waves (Beres scheme, deep). !------------------------------------------------------------------ ! Allocate wavenumber fields. - allocate(tau(ncol,-band_mid%ngwv:band_mid%ngwv,pver+1)) - allocate(gwut(ncol,pver,-band_mid%ngwv:band_mid%ngwv)) - allocate(c(ncol,-band_mid%ngwv:band_mid%ngwv)) + allocate(tau(ncol,-band_mid%ngwv:band_mid%ngwv,pver+1),stat=istat) + call alloc_err(istat,'gw_tend','tau',ncol*(band_mid%ngwv**2+1)*(pver+1)) + allocate(gwut(ncol,pver,-band_mid%ngwv:band_mid%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','gwut',ncol*pver*(band_mid%ngwv**2+1)) + allocate(phase_speeds(ncol,-band_mid%ngwv:band_mid%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','tau',ncol*(band_mid%ngwv**2+1)) ! Set up heating call pbuf_get_field(pbuf, ttend_dp_idx, ttend_dp) @@ -1478,18 +1819,18 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Determine wave sources for Beres deep scheme call gw_beres_src(ncol, band_mid, beres_dp_desc, & u, v, ttend_dp(:ncol,:), zm, src_level, tend_level, tau, & - ubm, ubi, xv, yv, c, hdepth, maxq0) + ubm, ubi, xv, yv, phase_speeds, hdepth, maxq0) ! Solve for the drag profile with Beres source spectrum. call gw_drag_prof(ncol, band_mid, p, src_level, tend_level, dt, & t, vramp, & piln, rhoi, nm, ni, ubm, ubi, xv, yv, & - effgw, c, kvtt, q, dse, tau, utgw, vtgw, & + effgw, phase_speeds, kvtt, q, dse, tau, utgw, vtgw, & ttgw, qtgw, egwdffi, gwut, dttdf, dttke, & lapply_effgw_in=gw_apply_tndmax) ! Project stress into directional components. - taucd = calc_taucd(ncol, band_mid%ngwv, tend_level, tau, c, xv, yv, ubi) + taucd = calc_taucd(ncol, band_mid%ngwv, tend_level, tau, phase_speeds, xv, yv, ubi) ! add the diffusion coefficients do k = 1, pver+1 @@ -1526,7 +1867,7 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Change ttgw to a temperature tendency before outputing it. ttgw = ttgw / cpair - call gw_spec_outflds(beres_dp_pf, lchnk, ncol, band_mid, c, u, v, & + call gw_spec_outflds(beres_dp_pf, lchnk, ncol, band_mid, phase_speeds, u, v, & xv, yv, gwut, dttdf, dttke, tau(:,:,2:), utgw, vtgw, ttgw, & taucd) @@ -1535,7 +1876,7 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) call outfld('HDEPTH', hdepth/1000._r8, ncol, lchnk) call outfld('MAXQ0', maxq0, ncol, lchnk) - deallocate(tau, gwut, c) + deallocate(tau, gwut, phase_speeds) end if @@ -1545,9 +1886,12 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) !------------------------------------------------------------------ ! Allocate wavenumber fields. - allocate(tau(ncol,-band_mid%ngwv:band_mid%ngwv,pver+1)) - allocate(gwut(ncol,pver,-band_mid%ngwv:band_mid%ngwv)) - allocate(c(ncol,-band_mid%ngwv:band_mid%ngwv)) + allocate(tau(ncol,-band_mid%ngwv:band_mid%ngwv,pver+1),stat=istat) + call alloc_err(istat,'gw_tend','tau',ncol*(band_mid%ngwv**2+1)*(pver+1)) + allocate(gwut(ncol,pver,-band_mid%ngwv:band_mid%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','gwut',ncol*pver*(band_mid%ngwv**2+1)) + allocate(phase_speeds(ncol,-band_mid%ngwv:band_mid%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','phase_speeds',ncol*(band_mid%ngwv**2+1)) ! Set up heating call pbuf_get_field(pbuf, ttend_sh_idx, ttend_sh) @@ -1563,18 +1907,18 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Determine wave sources for Beres shallow scheme call gw_beres_src(ncol, band_mid, beres_sh_desc, & u, v, ttend_sh(:ncol,:), zm, src_level, tend_level, tau, & - ubm, ubi, xv, yv, c, hdepth, maxq0) + ubm, ubi, xv, yv, phase_speeds, hdepth, maxq0) ! Solve for the drag profile with Beres source spectrum. call gw_drag_prof(ncol, band_mid, p, src_level, tend_level, dt, & t, vramp, & piln, rhoi, nm, ni, ubm, ubi, xv, yv, & - effgw, c, kvtt, q, dse, tau, utgw, vtgw, & + effgw, phase_speeds, kvtt, q, dse, tau, utgw, vtgw, & ttgw, qtgw, egwdffi, gwut, dttdf, dttke, & lapply_effgw_in=gw_apply_tndmax) ! Project stress into directional components. - taucd = calc_taucd(ncol, band_mid%ngwv, tend_level, tau, c, xv, yv, ubi) + taucd = calc_taucd(ncol, band_mid%ngwv, tend_level, tau, phase_speeds, xv, yv, ubi) ! add the diffusion coefficients do k = 1, pver+1 @@ -1607,7 +1951,7 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Change ttgw to a temperature tendency before outputing it. ttgw = ttgw / cpair - call gw_spec_outflds(beres_sh_pf, lchnk, ncol, band_mid, c, u, v, & + call gw_spec_outflds(beres_sh_pf, lchnk, ncol, band_mid, phase_speeds, u, v, & xv, yv, gwut, dttdf, dttke, tau(:,:,2:), utgw, vtgw, ttgw, & taucd) @@ -1616,7 +1960,7 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) call outfld ('SHDEPTH', hdepth/1000._r8, ncol, lchnk) call outfld ('SMAXQ0', maxq0, ncol, lchnk) - deallocate(tau, gwut, c) + deallocate(tau, gwut, phase_speeds) end if @@ -1636,9 +1980,12 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) !------------------------------------------------------------------ ! Allocate wavenumber fields. - allocate(tau(ncol,-band_mid%ngwv:band_mid%ngwv,pver+1)) - allocate(gwut(ncol,pver,-band_mid%ngwv:band_mid%ngwv)) - allocate(c(ncol,-band_mid%ngwv:band_mid%ngwv)) + allocate(tau(ncol,-band_mid%ngwv:band_mid%ngwv,pver+1),stat=istat) + call alloc_err(istat,'gw_tend','tau',ncol*(band_mid%ngwv**2+1)*(pver+1)) + allocate(gwut(ncol,pver,-band_mid%ngwv:band_mid%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','gwut',ncol*pver*(band_mid%ngwv**2+1)) + allocate(phase_speeds(ncol,-band_mid%ngwv:band_mid%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','tau',ncol*(band_mid%ngwv**2+1)) ! Efficiency of gravity wave momentum transfer. effgw = effgw_cm @@ -1648,18 +1995,18 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Determine the wave source for C&M background spectrum call gw_cm_src(ncol, band_mid, cm_desc, u, v, frontgf(:ncol,:), & - src_level, tend_level, tau, ubm, ubi, xv, yv, c) + src_level, tend_level, tau, ubm, ubi, xv, yv, phase_speeds) ! Solve for the drag profile with C&M source spectrum. call gw_drag_prof(ncol, band_mid, p, src_level, tend_level, dt, & t, vramp, & piln, rhoi, nm, ni, ubm, ubi, xv, yv, & - effgw, c, kvtt, q, dse, tau, utgw, vtgw, & + effgw, phase_speeds, kvtt, q, dse, tau, utgw, vtgw, & ttgw, qtgw, egwdffi, gwut, dttdf, dttke, & lapply_effgw_in=gw_apply_tndmax) ! Project stress into directional components. - taucd = calc_taucd(ncol, band_mid%ngwv, tend_level, tau, c, xv, yv, ubi) + taucd = calc_taucd(ncol, band_mid%ngwv, tend_level, tau, phase_speeds, xv, yv, ubi) ! add the diffusion coefficients do k = 1, pver+1 @@ -1696,11 +2043,11 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Change ttgw to a temperature tendency before outputing it. ttgw = ttgw / cpair - call gw_spec_outflds(cm_pf, lchnk, ncol, band_mid, c, u, v, & + call gw_spec_outflds(cm_pf, lchnk, ncol, band_mid, phase_speeds, u, v, & xv, yv, gwut, dttdf, dttke, tau(:,:,2:), utgw, vtgw, ttgw, & taucd) - deallocate(tau, gwut, c) + deallocate(tau, gwut, phase_speeds) end if @@ -1710,10 +2057,14 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) !------------------------------------------------------------------ ! Allocate wavenumber fields. - allocate(tau(ncol,-band_long%ngwv:band_long%ngwv,pver+1)) - allocate(gwut(ncol,pver,-band_long%ngwv:band_long%ngwv)) - allocate(c(ncol,-band_long%ngwv:band_long%ngwv)) - allocate(ro_adjust(ncol,-band_long%ngwv:band_long%ngwv,pver+1)) + allocate(tau(ncol,-band_long%ngwv:band_long%ngwv,pver+1),stat=istat) + call alloc_err(istat,'gw_tend','tau',ncol*(band_long%ngwv**2+1)*(pver+1)) + allocate(gwut(ncol,pver,-band_long%ngwv:band_long%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','gwut',ncol*pver*(band_long%ngwv**2+1)) + allocate(phase_speeds(ncol,-band_long%ngwv:band_long%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','phase_speeds',ncol*(band_long%ngwv**2+1)) + allocate(ro_adjust(ncol,-band_long%ngwv:band_long%ngwv,pver+1),stat=istat) + call alloc_err(istat,'gw_tend','ro_adjust',ncol*(band_long%ngwv**2+1)*(pver+1)) ! Efficiency of gravity wave momentum transfer. effgw = effgw_cm_igw @@ -1732,21 +2083,21 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Determine the wave source for C&M background spectrum call gw_cm_src(ncol, band_long, cm_igw_desc, u, v, frontgf(:ncol,:), & - src_level, tend_level, tau, ubm, ubi, xv, yv, c) + src_level, tend_level, tau, ubm, ubi, xv, yv, phase_speeds) - call adjust_inertial(band_long, tend_level, u_coriolis, c, ubi, & + call adjust_inertial(band_long, tend_level, u_coriolis, phase_speeds, ubi, & tau, ro_adjust) ! Solve for the drag profile with C&M source spectrum. call gw_drag_prof(ncol, band_long, p, src_level, tend_level, dt, & t, vramp, & piln, rhoi, nm, ni, ubm, ubi, xv, yv, & - effgw, c, kvtt, q, dse, tau, utgw, vtgw, & + effgw, phase_speeds, kvtt, q, dse, tau, utgw, vtgw, & ttgw, qtgw, egwdffi, gwut, dttdf, dttke, ro_adjust=ro_adjust, & lapply_effgw_in=gw_apply_tndmax) ! Project stress into directional components. - taucd = calc_taucd(ncol, band_long%ngwv, tend_level, tau, c, xv, yv, ubi) + taucd = calc_taucd(ncol, band_long%ngwv, tend_level, tau, phase_speeds, xv, yv, ubi) ! add the diffusion coefficients do k = 1, pver+1 @@ -1783,11 +2134,11 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Change ttgw to a temperature tendency before outputing it. ttgw = ttgw / cpair - call gw_spec_outflds(cm_igw_pf, lchnk, ncol, band_long, c, u, v, & + call gw_spec_outflds(cm_igw_pf, lchnk, ncol, band_long, phase_speeds, u, v, & xv, yv, gwut, dttdf, dttke, tau(:,:,2:), utgw, vtgw, ttgw, & taucd) - deallocate(tau, gwut, c, ro_adjust) + deallocate(tau, gwut, phase_speeds, ro_adjust) end if @@ -1797,9 +2148,12 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) !--------------------------------------------------------------------- ! Allocate wavenumber fields. - allocate(tau(ncol,band_oro%ngwv:band_oro%ngwv,pver+1)) - allocate(gwut(ncol,pver,band_oro%ngwv:band_oro%ngwv)) - allocate(c(ncol,band_oro%ngwv:band_oro%ngwv)) + allocate(tau(ncol,band_oro%ngwv:band_oro%ngwv,pver+1),stat=istat) + call alloc_err(istat,'gw_tend','tau',ncol*(band_oro%ngwv**2+1)*(pver+1)) + allocate(gwut(ncol,pver,band_oro%ngwv:band_oro%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','gwut',ncol*pver*(band_oro%ngwv**2+1)) + allocate(phase_speeds(ncol,band_oro%ngwv:band_oro%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','phase_speeds',ncol*(band_oro%ngwv**2+1)) ! Efficiency of gravity wave momentum transfer. ! Take into account that wave sources are only over land. @@ -1817,14 +2171,14 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Determine the orographic wave source call gw_oro_src(ncol, band_oro, p, & u, v, t, sgh_scaled, zm, nm, & - src_level, tend_level, tau, ubm, ubi, xv, yv, c) + src_level, tend_level, tau, ubm, ubi, xv, yv, phase_speeds) else effgw = effgw_oro ! Determine the orographic wave source call gw_oro_src(ncol, band_oro, p, & u, v, t, sgh(:ncol), zm, nm, & - src_level, tend_level, tau, ubm, ubi, xv, yv, c) + src_level, tend_level, tau, ubm, ubi, xv, yv, phase_speeds) endif do i = 1, ncol if (state1%lat(i) < 0._r8) then @@ -1836,7 +2190,7 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) call gw_drag_prof(ncol, band_oro, p, src_level, tend_level, dt, & t, vramp, & piln, rhoi, nm, ni, ubm, ubi, xv, yv, & - effgw,c, kvtt, q, dse, tau, utgw, vtgw, & + effgw, phase_speeds, kvtt, q, dse, tau, utgw, vtgw, & ttgw, qtgw, egwdffi, gwut, dttdf, dttke, & lapply_effgw_in=gw_apply_tndmax) @@ -1885,7 +2239,7 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) call outfld('TAUGWX', tau0x, ncol, lchnk) call outfld('TAUGWY', tau0y, ncol, lchnk) - deallocate(tau, gwut, c) + deallocate(tau, gwut, phase_speeds) end if @@ -2040,13 +2394,13 @@ subroutine gw_rdg_calc( & !---------------------------Local storage------------------------------- - integer :: k, m, nn + integer :: k, m, nn, istat real(r8), allocatable :: tau(:,:,:) ! wave Reynolds stress ! gravity wave wind tendency for each wave real(r8), allocatable :: gwut(:,:,:) ! Wave phase speeds for each column - real(r8), allocatable :: c(:,:) + real(r8), allocatable :: phase_speeds(:,:) ! Isotropic source flag [anisotropic orography]. integer :: isoflag(ncol) @@ -2139,9 +2493,12 @@ subroutine gw_rdg_calc( & !---------------------------------------------------------------------------- ! Allocate wavenumber fields. - allocate(tau(ncol,band_oro%ngwv:band_oro%ngwv,pver+1)) - allocate(gwut(ncol,pver,band_oro%ngwv:band_oro%ngwv)) - allocate(c(ncol,band_oro%ngwv:band_oro%ngwv)) + allocate(tau(ncol,band_oro%ngwv:band_oro%ngwv,pver+1),stat=istat) + call alloc_err(istat,'gw_rdg_calc','tau',ncol*(band_oro%ngwv**2+1)*(pver+1)) + allocate(gwut(ncol,pver,band_oro%ngwv:band_oro%ngwv),stat=istat) + call alloc_err(istat,'rdg_calc','gwut',ncol*pver*(band_oro%ngwv**2+1)) + allocate(phase_speeds(ncol,band_oro%ngwv:band_oro%ngwv),stat=istat) + call alloc_err(istat,'rdg_calc','phase_speeds',ncol*(band_oro%ngwv**2+1)) ! initialize accumulated momentum fluxes and tendencies taurx = 0._r8 @@ -2160,7 +2517,7 @@ subroutine gw_rdg_calc( & call gw_rdg_src(ncol, band_oro, p, & u, v, t, mxdis(:,nn), angll(:,nn), anixy(:,nn), kwvrdg, isoflag, zi, nm, & src_level, tend_level, bwv_level, tlb_level, tau, ubm, ubi, xv, yv, & - ubmsrc, usrc, vsrc, nsrc, rsrc, m2src, tlb, bwv, Fr1, Fr2, Frx, c) + ubmsrc, usrc, vsrc, nsrc, rsrc, m2src, tlb, bwv, Fr1, Fr2, Frx, phase_speeds) call gw_rdg_belowpeak(ncol, band_oro, rdg_cd_llb, & t, mxdis(:,nn), anixy(:,nn), kwvrdg, & @@ -2180,7 +2537,7 @@ subroutine gw_rdg_calc( & call gw_drag_prof(ncol, band_oro, p, src_level, tend_level, dt, & t, vramp, & piln, rhoi, nm, ni, ubm, ubi, xv, yv, & - effgw, c, kvtt, q, dse, tau, utgw, vtgw, & + effgw, phase_speeds, kvtt, q, dse, tau, utgw, vtgw, & ttgw, qtgw, egwdffi, gwut, dttdf, dttke, & kwvrdg=kwvrdg, & satfac_in = 1._r8, lapply_vdiff=gw_rdg_do_vdiff , tau_diag=tau_diag ) @@ -2276,7 +2633,7 @@ subroutine gw_rdg_calc( & call outfld(fname(4), vtrdg, ncol, lchnk) call outfld('TTGWORO', ttrdg / cpair, ncol, lchnk) - deallocate(tau, gwut, c) + deallocate(tau, gwut, phase_speeds) end subroutine gw_rdg_calc @@ -2310,25 +2667,25 @@ subroutine gw_spec_addflds(prefix, scheme, band, history_defaults) !----------------------------------------------------------------------- ! Overall wind tendencies. - call addfld (trim(prefix)//'UTGWSPEC',(/ 'lev' /), 'A','m/s2', & + call addfld (trim(prefix)//'UTGWSPEC',(/ 'lev' /), 'A','m s-2', & trim(scheme)//' U tendency - gravity wave spectrum') - call addfld (trim(prefix)//'VTGWSPEC',(/ 'lev' /), 'A','m/s2', & + call addfld (trim(prefix)//'VTGWSPEC',(/ 'lev' /), 'A','m s-2', & trim(scheme)//' V tendency - gravity wave spectrum') call register_vector_field(trim(prefix)//'UTGWSPEC',trim(prefix)//'VTGWSPEC') - call addfld (trim(prefix)//'TTGWSPEC',(/ 'lev' /), 'A','K/s', & + call addfld (trim(prefix)//'TTGWSPEC',(/ 'lev' /), 'A','K s-1', & trim(scheme)//' T tendency - gravity wave spectrum') ! Wind tendencies broken across five spectral bins. - call addfld (trim(prefix)//'UTEND1', (/ 'lev' /), 'A','m/s2', & + call addfld (trim(prefix)//'UTEND1', (/ 'lev' /), 'A','m s-2', & trim(scheme)//' U tendency c < -40') - call addfld (trim(prefix)//'UTEND2', (/ 'lev' /), 'A','m/s2', & + call addfld (trim(prefix)//'UTEND2', (/ 'lev' /), 'A','m s-2', & trim(scheme)//' U tendency -40 < c < -15') - call addfld (trim(prefix)//'UTEND3', (/ 'lev' /), 'A','m/s2', & + call addfld (trim(prefix)//'UTEND3', (/ 'lev' /), 'A','m s-2', & trim(scheme)//' U tendency -15 < c < 15') - call addfld (trim(prefix)//'UTEND4', (/ 'lev' /), 'A','m/s2', & + call addfld (trim(prefix)//'UTEND4', (/ 'lev' /), 'A','m s-2', & trim(scheme)//' U tendency 15 < c < 40') - call addfld (trim(prefix)//'UTEND5', (/ 'lev' /), 'A','m/s2', & + call addfld (trim(prefix)//'UTEND5', (/ 'lev' /), 'A','m s-2', & trim(scheme)//' U tendency 40 < c ') ! Reynold's stress toward each cardinal direction, and net zonal stress. @@ -2354,9 +2711,9 @@ subroutine gw_spec_addflds(prefix, scheme, band, history_defaults) trim(scheme)//' Southward MF') ! Temperature tendency terms. - call addfld (trim(prefix)//'TTGWSDF' , (/ 'lev' /), 'A','K/s', & + call addfld (trim(prefix)//'TTGWSDF' , (/ 'lev' /), 'A','K s-1', & trim(scheme)//' t tendency - diffusion term') - call addfld (trim(prefix)//'TTGWSKE' , (/ 'lev' /), 'A','K/s', & + call addfld (trim(prefix)//'TTGWSKE' , (/ 'lev' /), 'A','K s-1', & trim(scheme)//' t tendency - kinetic energy conversion term') ! Gravity wave source spectra by wave number. @@ -2366,7 +2723,7 @@ subroutine gw_spec_addflds(prefix, scheme, band, history_defaults) dumc1x = tau_fld_name(l, prefix, x_not_y=.true.) dumc1y = tau_fld_name(l, prefix, x_not_y=.false.) - dumc2 = trim(scheme)//" tau at c= "//trim(fnum)//" m/s" + dumc2 = trim(scheme)//" tau at c= "//trim(fnum)//" m s-1" call addfld (trim(dumc1x),(/ 'lev' /), 'A','Pa',dumc2) call addfld (trim(dumc1y),(/ 'lev' /), 'A','Pa',dumc2) @@ -2388,7 +2745,7 @@ end subroutine gw_spec_addflds !========================================================================== ! Outputs for spectral waves. -subroutine gw_spec_outflds(prefix, lchnk, ncol, band, c, u, v, xv, yv, & +subroutine gw_spec_outflds(prefix, lchnk, ncol, band, phase_speeds, u, v, xv, yv, & gwut, dttdf, dttke, tau, utgw, vtgw, ttgw, taucd) use gw_common, only: west, east, south, north @@ -2401,7 +2758,7 @@ subroutine gw_spec_outflds(prefix, lchnk, ncol, band, c, u, v, xv, yv, & ! Wave speeds. type(GWBand), intent(in) :: band ! Wave phase speeds for each column. - real(r8), intent(in) :: c(ncol,-band%ngwv:band%ngwv) + real(r8), intent(in) :: phase_speeds(ncol,-band%ngwv:band%ngwv) ! Winds at cell midpoints. real(r8), intent(in) :: u(ncol,pver) real(r8), intent(in) :: v(ncol,pver) @@ -2453,7 +2810,7 @@ subroutine gw_spec_outflds(prefix, lchnk, ncol, band, c, u, v, xv, yv, & utb = 0._r8 ! Find which output bin the phase speed corresponds to. - ix = find_bin(c) + ix = find_bin(phase_speeds) ! Put the wind tendency in that bin. do l = -band%ngwv, band%ngwv @@ -2487,12 +2844,12 @@ subroutine gw_spec_outflds(prefix, lchnk, ncol, band, c, u, v, xv, yv, & taux = 0._r8 tauy = 0._r8 - ! Project c, and convert each component to a wavenumber index. + ! Project phase_speeds, and convert each component to a wavenumber index. ! These are mappings from the wavenumber index of tau to those of taux ! and tauy, respectively. do l=-band%ngwv,band%ngwv - ix(:,l) = c_to_l(c(:,l)*xv) - iy(:,l) = c_to_l(c(:,l)*yv) + ix(:,l) = c_to_l(phase_speeds(:,l)*xv) + iy(:,l) = c_to_l(phase_speeds(:,l)*yv) end do ! Find projection of tau. diff --git a/src/physics/cam/gw_movmtn.F90 b/src/physics/cam/gw_movmtn.F90 new file mode 100644 index 0000000000..0408928932 --- /dev/null +++ b/src/physics/cam/gw_movmtn.F90 @@ -0,0 +1,444 @@ +module gw_movmtn + +! +! This module parameterizes gravity waves generated by the obstacle effect produced by +! boundary layer turbulence for convection. +! + +use gw_utils, only: r8 + +implicit none +private +save + +public :: MovMtnSourceDesc +public :: gw_movmtn_src + +type :: MovMtnSourceDesc + ! Whether wind speeds are shifted to be relative to storm cells. + logical :: storm_shift + ! Index for level where wind speed is used as the source speed. + integer :: k + ! Heating depths below this value [m] will be ignored. + real(r8) :: min_hdepth + ! Table bounds, for convenience. (Could be inferred from shape(mfcc).) + integer :: maxh !-bounds of the lookup table heating depths + integer :: maxuh ! bounds of the lookup table wind + ! Heating depths [m]. + real(r8), allocatable :: hd(:), uh(:) + ! Table of source spectra. + real(r8), allocatable :: mfcc(:,:,:) !is the lookup table f(depth, wind, phase speed) +end type MovMtnSourceDesc + +contains + +!========================================================================== + +subroutine gw_movmtn_src(ncol,lchnk, band, desc, u, v, & + netdt, netdt_shcu, xpwp_shcu, & + zm, alpha_gw_movmtn, src_level, tend_level, tau, ubm, ubi, xv, yv, & + c, hdepth) +!----------------------------------------------------------------------- +! Flexible driver for gravity wave source from obstacle effects produced +! by boundary layer turbulence or deep convection +!----------------------------------------------------------------------- + use gw_utils, only: get_unit_vector, dot_2d, midpoint_interp + use gw_common, only: GWBand, pver, qbo_hdepth_scaling + use cam_history, only: outfld + use phys_control, only: use_gw_movmtn_pbl + use physconst, only: rair, gravit +!------------------------------Arguments-------------------------------- + ! Column dimension. + integer, intent(in) :: ncol , lchnk + + ! Wavelengths triggered by convection. + type(GWBand), intent(in) :: band + + ! Settings for convection type (e.g. deep vs shallow). + type(MovMtnSourceDesc), intent(in) :: desc + + ! Midpoint zonal/meridional winds. + real(r8), intent(in) :: u(ncol,pver), v(ncol,pver) + ! Heating rate due to convection. + real(r8), intent(in) :: netdt(:,:) !from deep scheme + ! Heating rate due to shallow convection and PBL turbulence. + real(r8), intent(in) :: netdt_shcu(:,:) + ! Higher order flux from ShCu/PBL. + real(r8), intent(in) :: xpwp_shcu(ncol,pver+1) + ! Midpoint altitudes. + real(r8), intent(in) :: zm(ncol,pver) + ! tunable parameter controlling proportion of PBL momentum flux emitted as GW + real(r8), intent(in) :: alpha_gw_movmtn + + ! Indices of top gravity wave source level and lowest level where wind + ! tendencies are allowed. + integer, intent(out) :: src_level(ncol) + integer, intent(out) :: tend_level(ncol) + + ! Wave Reynolds stress. + real(r8), intent(out) :: tau(ncol,-band%ngwv:band%ngwv,pver+1) !tau = momentum flux (m2/s2) at interface level ngwv = band of phase speeds + ! Projection of wind at midpoints and interfaces. + real(r8), intent(out) :: ubm(ncol,pver), ubi(ncol,pver+1) + ! Unit vectors of source wind (zonal and meridional components). + real(r8), intent(out) :: xv(ncol), yv(ncol) !determined by vector direction of wind at source + ! Phase speeds. + real(r8), intent(out) :: c(ncol,-band%ngwv:band%ngwv) + + ! Heating depth [m] and maximum heating in each column. + real(r8), intent(out) :: hdepth(ncol) !calculated here in this code + +!---------------------------Local Storage------------------------------- + ! Column and (vertical) level indices. + integer :: i, k + + ! Zonal/meridional wind at steering level, i.e., 'cell speed'. + ! May be later modified by retrograde motion .... + real(r8) :: usteer(ncol), vsteer(ncol) + real(r8) :: uwavef(ncol,pver),vwavef(ncol,pver) + ! Steering level (integer converted to real*8) + real(r8) :: steer_level(ncol) + ! Retrograde motion of Cell + real(r8) :: Cell_Retro_Speed(ncol) + + ! Maximum heating rate. + real(r8) :: q0(ncol), qj(ncol) + ! unit vector components at steering level and mag + real(r8) :: xv_steer(ncol), yv_steer(ncol), umag_steer(ncol) + ! Bottom/top heating range index. + integer :: boti(ncol), topi(ncol) + ! Index for looking up heating depth dimension in the table. + integer :: hd_idx(ncol) + ! Mean wind in heating region. + real(r8) :: uh(ncol) + ! Min/max wavenumber for critical level filtering. + integer :: Umini(ncol), Umaxi(ncol) + ! Source level tau for a column. + real(r8) :: tau0(-band%ngwv:band%ngwv) + ! Speed of convective cells relative to storm. + real(r8) :: CS(ncol),CS1(ncol) + ! Wind speeds in wave direction + real(r8) :: udiff(ncol),vdiff(ncol) + ! "on-crest" source level wind + real(r8) :: ubmsrc(ncol),ubisrc(ncol) + + ! Index to shift spectra relative to ground. + integer :: shift + ! Other wind quantities + real(r8) :: ut(ncol),uc(ncol),umm(ncol) + ! Tau from moving mountain lookup table + real(r8) :: taumm(ncol) + ! Heating rate conversion factor. -> tuning factors + real(r8), parameter :: CF = 20._r8 !(1/ (5%)) -> 5% of grid cell is covered with convection + ! Averaging length. + real(r8), parameter :: AL = 1.0e5_r8 + ! Index for moving mountain lookuptable + integer :: hdmm_idx(ncol), uhmm_idx(ncol) + ! Index for ground based phase speed bin + real(r8) :: c0(ncol,-band%ngwv:band%ngwv) + integer :: c_idx(ncol,-band%ngwv:band%ngwv) + ! Flux source from ShCu/PBL + real(r8) :: xpwp_src(ncol) + ! Manual steering level set + integer :: Steer_k + + !---------------------------------------------------------------------- + ! Initialize tau array + !---------------------------------------------------------------------- + tau = 0.0_r8 + hdepth = 0.0_r8 + q0 = 0.0_r8 + tau0 = 0.0_r8 + + !---------------------------------------------------------------------- + ! Calculate flux source from ShCu/PBL + !---------------------------------------------------------------------- + xpwp_src = shcu_flux_src( xpwp_shcu, ncol, pver+1, alpha_gw_movmtn ) + + !------------------------------------------------------------------------ + ! Determine wind and unit vectors approximately at the source (steering level), then + ! project winds. + !------------------------------------------------------------------------ + + ! Winds at 'steering level' + Steer_k = pver-1 + usteer = u(:,Steer_k) !k defined in line21 (at specified altitude) + vsteer = v(:,Steer_k) + steer_level = real(Steer_k,r8) + + ! all GW calculations on a plane, which in our case is the wind at source level -> ubi is wind in this plane + ! Get the unit vector components and magnitude at the source level. + call get_unit_vector(usteer, vsteer, xv_steer, yv_steer, umag_steer) + + !------------------------------------------------------------------------- + ! If we want to account for some retorgrade cell motion, + ! it should be done by vector subtraction from (usteer,vsteer). + ! We assume the retrograde motion is in the same direction as + ! (usteer,vsteer) or the unit vector (xv_steer,yv_steer). Then, the + ! vector retrograde motion is just: + ! = -Cell_Retrograde_Speed * (xv_steer,yv_steer) + ! and we would modify usteer and vsteer + ! usteer = usteer - Cell_Retrograde_Speed * xv_steer + ! vsteer = vsteer - Cell_Retrograde_Speed * yv_steer + !----------------------------------------------------------------------- + ! Cell_Retro_Speed is always =0 for now + !----------------------------------------------------------------------- + do i=1,ncol + Cell_Retro_Speed(i) = min( sqrt(usteer(i)**2 + vsteer(i)**2), 0._r8) + end do + do i=1,ncol + usteer(i) = usteer(i) - xv_steer(i)*Cell_Retro_Speed(i) + vsteer(i) = vsteer(i) - yv_steer(i)*Cell_Retro_Speed(i) + end do + !------------------------------------------------------------------------- + ! At this point (usteer,vsteer) is the cell-speed, or equivalently, the 2D + ! ground based wave phase speed for moving mountain GW + !------------------------------------------------------------------------- + + + ! Calculate heating depth. + ! + ! Heating depth is defined as the first height range from the bottom in + ! which heating rate is continuously positive. + !----------------------------------------------------------------------- + + ! First find the indices for the top and bottom of the heating range. + !nedt is heating profile from Zhang McFarlane (it's pressure coordinates, therefore k=0 is the top) + + boti = 0 !bottom + topi = 0 !top + + if (use_gw_movmtn_pbl) then + boti=pver + topi=Steer_k-10 ! desc%k-5 + else + do k = pver, 1, -1 !start at surface + do i = 1, ncol + if (boti(i) == 0) then + ! Detect if we are outside the maximum range (where z = 20 km). + if (zm(i,k) >= 20000._r8) then + boti(i) = k + topi(i) = k + else + ! First spot where heating rate is positive. + if (netdt(i,k) > 0.0_r8) boti(i) = k + end if + else if (topi(i) == 0) then + ! Detect if we are outside the maximum range (z = 20 km). + if (zm(i,k) >= 20000._r8) then + topi(i) = k + else + ! First spot where heating rate is no longer positive. + if (.not. (netdt(i,k) > 0.0_r8)) topi(i) = k + end if + end if + end do + ! When all done, exit. + if (all(topi /= 0)) exit + end do + end if + ! Heating depth in m. (top-bottom altitudes) + hdepth = [ ( (zm(i,topi(i))-zm(i,boti(i))), i = 1, ncol ) ] + hd_idx = index_of_nearest(hdepth, desc%hd) + + ! hd_idx=0 signals that a heating depth is too shallow, i.e. that it is + ! either not big enough for the lowest table entry, or it is below the + ! minimum allowed for this convection type. + ! Values above the max in the table still get the highest value, though. + + where (hdepth < max(desc%min_hdepth, desc%hd(1))) hd_idx = 0 + + ! Maximum heating rate. + do k = minval(topi), maxval(boti) + where (k >= topi .and. k <= boti) + q0 = max(q0, netdt(:,k)) + end where + end do + + ! Multiply by conversion factor + ! (now 20* larger than what Zhang McFarlane said as they try to describe heating over 100km grid cell) + q0 = q0 * CF + qj = gravit/rair*q0 ! unit conversion to m/s3 + + !------------------------------------------------- + ! CS1 and CS should be equal in current implemen- + ! tation. + !------------------------------------------------- + CS1 = sqrt( usteer**2._r8 + vsteer**2._r8 ) + CS = CS1*xv_steer + CS1*yv_steer + + ! ----------------------------------------------------------- + ! Calculate winds in reference frame of wave (uwavef,vwavef). + ! This is like "(U-c)" in GW literature, where U and c are in + ! ground-based speeds in a plane perpendicular to wave fronts. + !------------------------------------------------------------ + do i=1,ncol + udiff(i) = u(i,topi(i)) - usteer(i) + vdiff(i) = v(i,topi(i)) - vsteer(i) + do k=1,pver + uwavef(i, k ) = u(i, k ) - usteer(i) + vwavef(i, k ) = v(i, k ) - vsteer(i) + end do + end do + !---------------------------------------------------------- + ! Wave relative wind at source level. This determines + ! orientation of wave in the XY plane, and therefore the + ! direction in which force from dissipating GW will be + ! applied. + !---------------------------------------------------------- + do i=1,ncol + udiff(i) = uwavef( i, topi(i) ) + vdiff(i) = vwavef( i, topi(i) ) + end do + !----------------------------------------------------------- + ! Unit vector components (xv,yv) in direction of wavevector + ! i.e., in which force will be applied + !----------------------------------------------------------- + call get_unit_vector(udiff , vdiff , xv, yv, ubisrc ) + + call outfld('UCELL_MOVMTN', usteer, ncol, lchnk) + call outfld('VCELL_MOVMTN', vsteer, ncol, lchnk) + call outfld('CS_MOVMTN', CS, ncol, lchnk) + call outfld('STEER_LEVEL_MOVMTN',steer_level, ncol, lchnk ) + call outfld('XPWP_SRC_MOVMTN', xpwp_src , ncol, lchnk ) + + !---------------------------------------------------------- + ! Project the local wave relative wind at midpoints onto the + ! direction of the wavevector. + !---------------------------------------------------------- + do k = 1, pver + ubm(:,k) = dot_2d(uwavef(:,k), vwavef(:,k), xv, yv) + end do + ! Source level on-crest wind + do i=1,ncol + ubmsrc(i) = ubm(i,topi(i)) + end do + + !--------------------------------------------------------------- + ! adjust everything so that source level wave relative on-crest + ! wind is always positive. Also adjust unit vector comps xv,yv + !-------------------------------------------------------------- + do k=1,pver + do i=1,ncol + ubm(i,k) = sign( 1._r8 , ubmsrc(i) )* ubm(i,k) + end do + end do + ! + do i=1,ncol + xv(i) = sign( 1._r8 , ubmsrc(i) ) * xv(i) + yv(i) = sign( 1._r8 , ubmsrc(i) ) * yv(i) + end do + + + + ! Compute the interface wind projection by averaging the midpoint winds. (both same wind profile, + ! just at different points of the grid) + + ! Use the top level wind at the top interface. + ubi(:,1) = ubm(:,1) + + ubi(:,2:pver) = midpoint_interp(ubm) + + !----------------------------------------------------------------------- + ! determine wind for lookup table + ! need wind speed at the top of the convecitve cell and at the steering level + uh = 0._r8 + do i=1,ncol + ut(i) = ubm(i,topi(i)) + uh(i) = ut(i) - CS(i) ! wind at top in the frame moving with the cell + end do + + ! Set phase speeds; just use reference speeds. + c(:,0) = 0._r8 + + !----------------------------------------------------------------------- + ! Gravity wave sources + !----------------------------------------------------------------------- + ! Start loop over all columns. + !----------------------------------------------------------------------- + do i=1,ncol + + !--------------------------------------------------------------------- + ! Look up spectrum only if the heating depth is large enough, else leave + ! tau = 0. + !--------------------------------------------------------------------- + if (.not. use_gw_movmtn_pbl) then + if (hd_idx(i) > 0) then + !------------------------------------------------------------------ + ! Look up the spectrum using depth and uh. + !------------------------------------------------------------------ + !hdmm_idx = index_of_nearest(hdepth, desc%hd) + uhmm_idx = index_of_nearest(uh, desc%uh) + taumm(i) = abs(desc%mfcc(uhmm_idx(i),hd_idx(i),0)) + taumm(i) = taumm(i)*qj(i)*qj(i)/AL/1000._r8 + ! assign sign to MF based on the ground based phase speed, ground based phase speed = CS + taumm(i) = -1._r8*sign(taumm(i),CS(i)) + !find the right phase speed bin + c0(i,:) = CS(i) + c_idx(i,:) = index_of_nearest(c0(i,:),c(i,:)) + + !input tau to top +1 level, interface level just below top of heating, remember it's in pressure + ! everything is upside down (source level of GWs, level where GWs are launched) + tau(i,c_idx(i,:),topi(i):topi(i)+1) = taumm(i) + + end if ! heating depth above min and not at the pole + else + tau(i,0,topi(i):pver+1 ) = xpwp_src(i) ! 0.1_r8/10000._r8 + endif + + enddo + !----------------------------------------------------------------------- + ! End loop over all columns. + !----------------------------------------------------------------------- + + ! Output the source level. + src_level = topi + tend_level = topi + + +end subroutine gw_movmtn_src + +! Short routine to get the indices of a set of values rounded to their +! nearest points on a grid. +pure function index_of_nearest(x, grid) result(idx) + real(r8), intent(in) :: x(:) + real(r8), intent(in) :: grid(:) + + integer :: idx(size(x)) + + real(r8) :: interfaces(size(grid)-1) + integer :: i, n + + n = size(grid) + interfaces = (grid(:n-1) + grid(2:))/2._r8 + + idx = 1 + do i = 1, n-1 + where (x > interfaces(i)) idx = i + 1 + end do + +end function index_of_nearest + +!!!!!!!!!!!!!!!!!!!!!!!!!!! +pure function shcu_flux_src (xpwp_shcu , ncol, pverx, alpha_gw_movmtn ) result(xpwp_src) + integer, intent(in) :: ncol,pverx + real(r8), intent(in) :: xpwp_shcu (ncol,pverx) + real(r8), intent(in) :: alpha_gw_movmtn + + real(r8) :: xpwp_src(ncol) + + integer :: k, nlayers + + !----------------------------------- + ! Simple average over layers. + ! Probably can do better + !----------------------------------- + nlayers=5 + xpwp_src(:) =0._r8 + do k = 0, nlayers-1 + xpwp_src(:) = xpwp_src(:) + xpwp_shcu(:,pverx-k) + end do + xpwp_src(:) = alpha_gw_movmtn * xpwp_src(:)/(1.0_r8*nlayers) + +end function shcu_flux_src + +end module gw_movmtn diff --git a/src/physics/cam/hb_diff.F90 b/src/physics/cam/hb_diff.F90 index ba97978e72..a3bb11a17d 100644 --- a/src/physics/cam/hb_diff.F90 +++ b/src/physics/cam/hb_diff.F90 @@ -262,7 +262,7 @@ subroutine compute_hb_free_atm_diff(ncol, & ! !----------------------------------------------------------------------- - use pbl_utils, only: virtem, calc_ustar, calc_obklen, austausch_atm + use pbl_utils, only: virtem, calc_ustar, calc_obklen, austausch_atm_free !------------------------------Arguments-------------------------------- ! @@ -321,7 +321,7 @@ subroutine compute_hb_free_atm_diff(ncol, & ! ! Get free atmosphere exchange coefficients ! - call austausch_atm(pcols, ncol, pver, ntop_turb, nbot_turb, & + call austausch_atm_free(pcols, ncol, pver, ntop_turb, nbot_turb, & ml2, ri, s2, kvf) kvq(:ncol,:) = kvf(:ncol,:) diff --git a/src/physics/cam/micro_pumas_cam.F90 b/src/physics/cam/micro_pumas_cam.F90 index fe516c84ea..dae867f9dc 100644 --- a/src/physics/cam/micro_pumas_cam.F90 +++ b/src/physics/cam/micro_pumas_cam.F90 @@ -12,8 +12,11 @@ module micro_pumas_cam use physconst, only: gravit, rair, tmelt, cpair, rh2o, rhoh2o, & latvap, latice, mwh2o use phys_control, only: phys_getopts, use_hetfrz_classnuc - - +use shr_const_mod, only: pi => shr_const_pi +use time_manager, only: get_curr_date, get_curr_calday +use phys_grid, only: get_rlat_all_p, get_rlon_all_p +use orbit, only: zenith + use physics_types, only: physics_state, physics_ptend, & physics_ptend_init, physics_state_copy, & physics_update, physics_state_dealloc, & @@ -197,6 +200,8 @@ module micro_pumas_cam ast_idx = -1, & cld_idx = -1, & concld_idx = -1, & + prec_dp_idx = -1, & + prec_sh_idx = -1, & qsatfac_idx = -1 ! Pbuf fields needed for subcol_SILHS @@ -1019,6 +1024,10 @@ subroutine micro_pumas_cam_init(pbuf2d) end if + call addfld ('RBFRAC', horiz_only, 'A', 'Fraction', 'Fraction of sky covered by a potential rainbow' ) + call addfld ('RBFREQ', horiz_only, 'A', 'Frequency', 'Potential rainbow frequency' ) + call addfld( 'rbSZA', horiz_only, 'I', 'degrees', 'solar zenith angle' ) + ! History variables for CAM5 microphysics call addfld ('MPDT', (/ 'lev' /), 'A', 'W/kg', 'Heating tendency - Morrison microphysics' ) call addfld ('MPDQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency - Morrison microphysics' ) @@ -1274,6 +1283,8 @@ subroutine micro_pumas_cam_init(pbuf2d) ast_idx = pbuf_get_index('AST') cld_idx = pbuf_get_index('CLD') concld_idx = pbuf_get_index('CONCLD') + prec_dp_idx = pbuf_get_index('PREC_DP') + prec_sh_idx = pbuf_get_index('PREC_SH') naai_idx = pbuf_get_index('NAAI') naai_hom_idx = pbuf_get_index('NAAI_HOM') @@ -1603,7 +1614,10 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) real(r8), pointer :: cld(:,:) ! Total cloud fraction real(r8), pointer :: concld(:,:) ! Convective cloud fraction - real(r8), pointer :: iciwpst(:,:) ! Stratiform in-cloud ice water path for radiation + real(r8), pointer :: prec_dp(:) ! Deep Convective precip + real(r8), pointer :: prec_sh(:) ! Shallow Convective precip + + real(r8), pointer :: iciwpst(:,:) ! Stratiform in-cloud ice water path for radiation real(r8), pointer :: iclwpst(:,:) ! Stratiform in-cloud liquid water path for radiation real(r8), pointer :: cldfsnow(:,:) ! Cloud fraction for liquid+snow real(r8), pointer :: icswp(:,:) ! In-cloud snow water path @@ -1834,6 +1848,34 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) real(r8), parameter :: mucon = 5.3_r8 ! Convective size distribution shape parameter real(r8), parameter :: deicon = 50._r8 ! Convective ice effective diameter (meters) + ! Rainbows: solar zenith angle (SZA) + real(r8) :: zen_angle(state%psetcols) ! Daytime solar zenith angles (radians) + real(r8) :: rlats(state%psetcols), rlons(state%psetcols) ! chunk latitudes and longitudes (radains) + real(r8) :: sza(state%psetcols) ! solar zenith angles (degrees) + real(r8), parameter :: rad2deg = 180._r8/pi ! radians to degrees conversion factor + real(r8) :: calday !current calendar day + + real(r8) :: precc(state%psetcols) ! convective precip rate + +! Rainbow frequency and fraction for output + + real(r8) :: rbfreq(state%psetcols) + real(r8) :: rbfrac(state%psetcols) + +!Rainbows: parameters + + real(r8), parameter :: rb_rmin =1.e-6_r8 ! Strat Rain threshold (mixing ratio) + real(r8), parameter :: rb_rcmin = 5._r8/(86400._r8*1000._r8) ! Conv Rain Threshold (mm/d--> m/s) + real(r8), parameter :: rb_pmin =85000._r8 ! Minimum pressure for surface layer + real(r8), parameter :: deg2rad = pi/180._r8 ! Conversion factor + integer :: top_idx !Index for top level below rb_pmin + real(r8) :: convmx + real(r8) :: cldmx + real(r8) :: frlow + real(r8) :: cldtot + real(r8) :: rmax + logical :: rval + !------------------------------------------------------------------------------- lchnk = state%lchnk @@ -1871,6 +1913,29 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), & col_type=col_type, copy_if_needed=use_subcol_microp) + ! Get convective precip + if (prec_dp_idx > 0) then + call pbuf_get_field(pbuf, prec_dp_idx, prec_dp, col_type=col_type, copy_if_needed=use_subcol_microp) + else + nullify(prec_dp) + end if + if (prec_sh_idx > 0) then + call pbuf_get_field(pbuf, prec_sh_idx, prec_sh, col_type=col_type, copy_if_needed=use_subcol_microp) + else + nullify(prec_sh) + end if + +! Merge Precipitation rates (multi-process) + if (associated(prec_dp) .and. associated(prec_sh)) then + precc(:ncol) = prec_dp(:ncol) + prec_sh(:ncol) + else if (associated(prec_dp)) then + precc(:ncol) = prec_dp(:ncol) + else if (associated(prec_sh)) then + precc(:ncol) = prec_sh(:ncol) + else + precc(:ncol) = 0._r8 + end if + if (.not. do_cldice) then ! If we are NOT prognosing ice and snow tendencies, then get them from the Pbuf call pbuf_get_field(pbuf, tnd_qsnow_idx, tnd_qsnow, col_type=col_type, copy_if_needed=use_subcol_microp) @@ -2043,6 +2108,26 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) call pbuf_get_field(pbuf, evpsnow_st_idx, evpsnow_st_grid) call pbuf_get_field(pbuf, am_evp_st_idx, am_evp_st_grid) + !----------------------------------------------------------------------- + ! ... Calculate cosine of zenith angle + ! then cast back to angle (radians) + !----------------------------------------------------------------------- + zen_angle(:) = 0.0_r8 + rlats(:) = 0.0_r8 + rlons(:) = 0.0_r8 + calday = get_curr_calday() + call get_rlat_all_p( lchnk, ncol, rlats ) + call get_rlon_all_p( lchnk, ncol, rlons ) + call zenith( calday, rlats, rlons, zen_angle, ncol ) + where (zen_angle(:) <= 1.0_r8 .and. zen_angle(:) >= -1.0_r8) + zen_angle(:) = acos( zen_angle(:) ) + elsewhere + zen_angle(:) = 0.0_r8 + end where + + sza(:) = zen_angle(:) * rad2deg + call outfld( 'rbSZA', sza, ncol, lchnk ) + !------------------------------------------------------------------------------------- ! Microphysics assumes 'liquid stratus frac = ice stratus frac ! = max( liquid stratus frac, ice stratus frac )'. @@ -2134,6 +2219,10 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) state_loc_numgraup(:ncol,:) = 0._r8 end if + ! Zero out diagnostic rainbow arrays + rbfreq = 0._r8 + rbfrac = 0._r8 + ! Zero out values above top_lev before passing into _tend for some pbuf variables that are inputs naai(:ncol,:top_lev-1) = 0._r8 npccn(:ncol,:top_lev-1) = 0._r8 @@ -3123,6 +3212,63 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) racau_grid = min(racau_grid, 1.e10_r8) +!----------------------------------------------------------------------- +! Diagnostic Rainbow Calculation. Seriously. +!----------------------------------------------------------------------- + +! Rainbows currently calculated on the grid, not subcolumn specific + do i = 1, ngrdcol + + top_idx = pver + convmx = 0._r8 + frlow = 0._r8 + cldmx = 0._r8 + cldtot = maxval(ast(i,top_lev:)) + +! Find levels in surface layer + do k = top_lev, pver + if (state%pmid(i,k) > rb_pmin) then + top_idx = min(k,top_idx) + end if + end do + +!For all fractional precip calculated below, use maximum in surface layer. +!For convective precip, base on convective cloud area + convmx = maxval(concld(i,top_idx:)) +!For stratiform precip, base on precip fraction + cldmx= maxval(freqr(i,top_idx:)) +! Combine and use maximum of strat or conv fraction + frlow= max(cldmx,convmx) + +!max precip + rmax=maxval(qrout_grid(i,top_idx:)) + +! Stratiform precip mixing ratio OR some convective precip +! (rval = true if any sig precip) + + rval = ((precc(i) > rb_rcmin) .or. (rmax > rb_rmin)) + +!Now can find conditions for a rainbow: +! Maximum cloud cover (CLDTOT) < 0.5 +! 48 < SZA < 90 +! freqr (below rb_pmin) > 0.25 +! Some rain (liquid > 1.e-6 kg/kg, convective precip > 1.e-7 m/s + + if ((cldtot < 0.5_r8) .and. (sza(i) > 48._r8) .and. (sza(i) < 90._r8) .and. rval) then + +!Rainbow 'probability' (area) derived from solid angle theory +!as the fraction of the hemisphere for a spherical cap with angle phi=sza-48. +! This is only valid between 48 < sza < 90 (controlled for above). + + rbfrac(i) = max(0._r8,(1._r8-COS((sza(i)-48._r8)*deg2rad))/2._r8) * frlow + rbfreq(i) = 1.0_r8 + end if + + end do ! end column loop for rainbows + + call outfld('RBFRAC', rbfrac, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('RBFREQ', rbfreq, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + ! --------------------- ! ! History Output Fields ! ! --------------------- ! diff --git a/src/physics/cam/nucleate_ice_cam.F90 b/src/physics/cam/nucleate_ice_cam.F90 index 922e871b72..7d03297688 100644 --- a/src/physics/cam/nucleate_ice_cam.F90 +++ b/src/physics/cam/nucleate_ice_cam.F90 @@ -261,7 +261,7 @@ subroutine nucleate_ice_cam_init(mincld_in, bulk_scale_in, pbuf2d, aero_props) call endrun(routine//': ERROR qsatfac is required when subgrid = -1 or subgrid_strat = -1') end if - if (cam_physpkg_is("cam_dev")) then + if (cam_physpkg_is("cam7")) then ! Updates for PUMAS v1.21+ call addfld('NIHFTEN', (/ 'lev' /), 'A', '1/m3/s', 'Activated Ice Number Concentration tendency due to homogenous freezing') call addfld('NIDEPTEN', (/ 'lev' /), 'A', '1/m3/s', 'Activated Ice Number Concentration tendency due to deposition nucleation') @@ -286,7 +286,7 @@ subroutine nucleate_ice_cam_init(mincld_in, bulk_scale_in, pbuf2d, aero_props) call addfld ('WICE', (/ 'lev' /), 'A','m/s','Vertical velocity Reduction caused by preexisting ice' ) call addfld ('WEFF', (/ 'lev' /), 'A','m/s','Effective Vertical velocity for ice nucleation' ) - if (cam_physpkg_is("cam_dev")) then + if (cam_physpkg_is("cam7")) then ! Updates for PUMAS v1.21+ call addfld ('INnso4TEN', (/ 'lev' /), 'A','1/m3/s','Number Concentration tendency so4 (in) to ice_nucleation') call addfld ('INnbcTEN', (/ 'lev' /), 'A','1/m3/s','Number Concentration tendency bc (in) to ice_nucleation') @@ -627,7 +627,7 @@ subroutine nucleate_ice_cam_calc( & ! *** Turn off soot nucleation *** soot_num = 0.0_r8 - if (cam_physpkg_is("cam_dev")) then + if (cam_physpkg_is("cam7")) then call nucleati( & wsubi(i,k), t(i,k), pmid(i,k), relhum(i,k), icldm(i,k), & @@ -768,7 +768,7 @@ subroutine nucleate_ice_cam_calc( & end if end if - if (cam_physpkg_is("cam_dev")) then + if (cam_physpkg_is("cam7")) then !Updates for pumas v1.21+ naai_hom(i,k) = nihf(i,k)/dtime @@ -808,7 +808,7 @@ subroutine nucleate_ice_cam_calc( & endif endif - else ! Not cam_dev + else ! Not cam7 naai_hom(i,k) = nihf(i,k) @@ -846,7 +846,7 @@ subroutine nucleate_ice_cam_calc( & endif end if - end if ! cam_dev + end if ! cam7 end if freezing end do iloop end do kloop @@ -857,7 +857,7 @@ subroutine nucleate_ice_cam_calc( & maerosol) end if - if (cam_physpkg_is("cam_dev")) then + if (cam_physpkg_is("cam7")) then ! Updates for PUMAS v1.21+ call outfld('NIHFTEN', nihf, pcols, lchnk) call outfld('NIIMMTEN', niimm, pcols, lchnk) @@ -877,7 +877,7 @@ subroutine nucleate_ice_cam_calc( & call outfld( 'fhom' , fhom, pcols, lchnk) call outfld( 'WICE' , wice, pcols, lchnk) call outfld( 'WEFF' , weff, pcols, lchnk) - if (cam_physpkg_is("cam_dev")) then + if (cam_physpkg_is("cam7")) then ! Updates for PUMAS v1.21+ call outfld('INnso4TEN',INnso4 , pcols,lchnk) call outfld('INnbcTEN',INnbc , pcols,lchnk) diff --git a/src/physics/cam/pbl_utils.F90 b/src/physics/cam/pbl_utils.F90 index c6d9efc750..66759e295d 100644 --- a/src/physics/cam/pbl_utils.F90 +++ b/src/physics/cam/pbl_utils.F90 @@ -27,7 +27,7 @@ module pbl_utils public calc_obklen public virtem public compute_radf -public austausch_atm +public austausch_atm, austausch_atm_free real(r8), parameter :: ustar_min = 0.01_r8 @@ -408,4 +408,62 @@ subroutine austausch_atm(pcols, ncol, pver, ntop, nbot, ml2, ri, s2, kvf) end subroutine austausch_atm +subroutine austausch_atm_free(pcols, ncol, pver, ntop, nbot, ml2, ri, s2, kvf) + + !---------------------------------------------------------------------- ! + ! ! + ! same as austausch_atm but only mixing for Ri<0 ! + ! i.e. no background mixing and mixing for Ri>0 ! + ! ! + !---------------------------------------------------------------------- ! + + ! --------------- ! + ! Input arguments ! + ! --------------- ! + + integer, intent(in) :: pcols ! Atmospheric columns dimension size + integer, intent(in) :: ncol ! Number of atmospheric columns + integer, intent(in) :: pver ! Number of atmospheric layers + integer, intent(in) :: ntop ! Top layer for calculation + integer, intent(in) :: nbot ! Bottom layer for calculation + + real(r8), intent(in) :: ml2(pver+1) ! Mixing lengths squared + real(r8), intent(in) :: s2(pcols,pver) ! Shear squared + real(r8), intent(in) :: ri(pcols,pver) ! Richardson no + + ! ---------------- ! + ! Output arguments ! + ! ---------------- ! + + real(r8), intent(out) :: kvf(pcols,pver+1) ! Eddy diffusivity for heat and tracers + + ! --------------- ! + ! Local Variables ! + ! --------------- ! + + real(r8) :: fofri ! f(ri) + real(r8) :: kvn ! Neutral Kv + + integer :: i ! Longitude index + integer :: k ! Vertical index + + ! ----------------------- ! + ! Main Computation Begins ! + ! ----------------------- ! + + kvf(:ncol,:) = 0.0_r8 + ! Compute the free atmosphere vertical diffusion coefficients: kvh = kvq = kvm. + do k = ntop, nbot - 1 + do i = 1, ncol + if( ri(i,k) < 0.0_r8 ) then + fofri = sqrt( max( 1._r8 - 18._r8 * ri(i,k), 0._r8 ) ) + else + fofri = 0.0_r8 + end if + kvn = ml2(k) * sqrt(s2(i,k)) + kvf(i,k+1) = kvn * fofri + end do + end do +end subroutine austausch_atm_free + end module pbl_utils diff --git a/src/physics/cam/phys_control.F90 b/src/physics/cam/phys_control.F90 index 92ccac1335..7105f2d6cd 100644 --- a/src/physics/cam/phys_control.F90 +++ b/src/physics/cam/phys_control.F90 @@ -56,7 +56,7 @@ module phys_control logical :: history_aerosol = .false. ! output the MAM aerosol variables and tendencies logical :: history_aero_optics = .false. ! output the aerosol logical :: history_eddy = .false. ! output the eddy variables -logical :: history_budget = .false. ! output tendencies and state variables for T, water vapor, +logical :: history_budget = .false. ! output tendencies and state variables for T, water vapor, ! cloud ice and cloud liquid budgets logical :: convproc_do_aer = .false. ! switch for new convective scavenging treatment for modal aerosols @@ -98,6 +98,7 @@ module phys_control logical, public, protected :: use_gw_front_igw = .false. ! Frontogenesis to inertial spectrum. logical, public, protected :: use_gw_convect_dp = .false. ! Deep convection. logical, public, protected :: use_gw_convect_sh = .false. ! Shallow convection. +logical, public, protected :: use_gw_movmtn_pbl = .false. ! moving mountain ! FV dycore angular momentum correction logical, public, protected :: fv_am_correction = .false. @@ -136,7 +137,7 @@ subroutine phys_ctl_readnl(nlfile) history_waccmx, history_chemistry, history_carma, history_clubb, history_dust, & history_cesm_forcing, history_scwaccm_forcing, history_chemspecies_srf, & do_clubb_sgs, state_debug_checks, use_hetfrz_classnuc, use_gw_oro, use_gw_front, & - use_gw_front_igw, use_gw_convect_dp, use_gw_convect_sh, cld_macmic_num_steps, & + use_gw_front_igw, use_gw_convect_dp, use_gw_convect_sh, use_gw_movmtn_pbl, cld_macmic_num_steps, & offline_driver, convproc_do_aer, cam_snapshot_before_num, cam_snapshot_after_num, & cam_take_snapshot_before, cam_take_snapshot_after, cam_physics_mesh, use_hemco, do_hb_above_clubb !----------------------------------------------------------------------------- @@ -193,6 +194,7 @@ subroutine phys_ctl_readnl(nlfile) call mpi_bcast(use_gw_front_igw, 1, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(use_gw_convect_dp, 1, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(use_gw_convect_sh, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(use_gw_movmtn_pbl, 1, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(cld_macmic_num_steps, 1, mpi_integer, masterprocid, mpicom, ierr) call mpi_bcast(offline_driver, 1, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(convproc_do_aer, 1, mpi_logical, masterprocid, mpicom, ierr) @@ -242,21 +244,21 @@ subroutine phys_ctl_readnl(nlfile) endif endif - if (cam_physpkg_is("cam_dev")) then + if (cam_physpkg_is("cam7")) then ! Check that eddy_scheme, macrop_scheme, shallow_scheme are all set to CLUBB if (eddy_scheme /= 'CLUBB_SGS' .or. macrop_scheme /= 'CLUBB_SGS' .or. shallow_scheme /= 'CLUBB_SGS') then - write(iulog,*) 'cam_dev is only compatible with CLUBB. Quitting' - call endrun('cam_dev is only compatible with eddy, macrop, and shallow schemes = CLUBB_SGS') + write(iulog,*) 'cam7 is only compatible with CLUBB. Quitting' + call endrun('cam7 is only compatible with eddy, macrop, and shallow schemes = CLUBB_SGS') end if ! Add a check to make sure SPCAM is not used if (use_spcam) then - write(iulog,*)'SPCAM not compatible with cam_dev physics. Quitting' - call endrun('SPCAM and cam_dev incompatible') + write(iulog,*)'SPCAM not compatible with cam7 physics. Quitting' + call endrun('SPCAM and cam7 incompatible') end if ! Add check to make sure we are not trying to use `camrt` if (trim(radiation_scheme) == 'camrt') then - write(iulog,*) ' camrt specified and it is not compatible with cam_dev' - call endrun('cam_dev is not compatible with camrt radiation scheme') + write(iulog,*) ' camrt specified and it is not compatible with cam7' + call endrun('cam7 is not compatible with camrt radiation scheme') end if end if diff --git a/src/physics/cam/physics_types.F90 b/src/physics/cam/physics_types.F90 index 9b0c23d2ff..03f8022fa8 100644 --- a/src/physics/cam/physics_types.F90 +++ b/src/physics/cam/physics_types.F90 @@ -1481,40 +1481,72 @@ end subroutine set_state_pdry !=============================================================================== -subroutine set_wet_to_dry (state) +subroutine set_wet_to_dry(state, convert_cnst_type) + + ! Convert mixing ratios from a wet to dry basis for constituents of type + ! convert_cnst_type. Constituents are given a type when they are added + ! to the constituent array by a call to cnst_add during the register + ! phase of initialization. There are two constituent types: 'wet' for + ! water species and 'dry' for non-water species. use constituents, only: pcnst, cnst_type type(physics_state), intent(inout) :: state + character(len=3), intent(in) :: convert_cnst_type + ! local variables integer m, ncol + character(len=*), parameter :: sub = 'set_wet_to_dry' + !----------------------------------------------------------------------------- + + ! check input + if (.not.(convert_cnst_type == 'wet' .or. convert_cnst_type == 'dry')) then + write(iulog,*) sub//': FATAL: convert_cnst_type not recognized: '//convert_cnst_type + call endrun(sub//': FATAL: convert_cnst_type not recognized: '//convert_cnst_type) + end if ncol = state%ncol - do m = 1,pcnst - if (cnst_type(m).eq.'dry') then + do m = 1, pcnst + if (cnst_type(m) == convert_cnst_type) then state%q(:ncol,:,m) = state%q(:ncol,:,m)*state%pdel(:ncol,:)/state%pdeldry(:ncol,:) - endif + end if end do end subroutine set_wet_to_dry !=============================================================================== -subroutine set_dry_to_wet (state) +subroutine set_dry_to_wet(state, convert_cnst_type) + + ! Convert mixing ratios from a dry to wet basis for constituents of type + ! convert_cnst_type. Constituents are given a type when they are added + ! to the constituent array by a call to cnst_add during the register + ! phase of initialization. There are two constituent types: 'wet' for + ! water species and 'dry' for non-water species. use constituents, only: pcnst, cnst_type type(physics_state), intent(inout) :: state + character(len=3), intent(in) :: convert_cnst_type + ! local variables integer m, ncol + character(len=*), parameter :: sub = 'set_dry_to_wet' + !----------------------------------------------------------------------------- + + ! check input + if (.not.(convert_cnst_type == 'wet' .or. convert_cnst_type == 'dry')) then + write(iulog,*) sub//': FATAL: convert_cnst_type not recognized: '//convert_cnst_type + call endrun(sub//': FATAL: convert_cnst_type not recognized: '//convert_cnst_type) + end if ncol = state%ncol - do m = 1,pcnst - if (cnst_type(m).eq.'dry') then + do m = 1, pcnst + if (cnst_type(m) == convert_cnst_type) then state%q(:ncol,:,m) = state%q(:ncol,:,m)*state%pdeldry(:ncol,:)/state%pdel(:ncol,:) - endif + end if end do end subroutine set_dry_to_wet diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index a439f84423..a2aaad5564 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -35,6 +35,7 @@ module physpkg use phys_control, only: use_hemco ! Use Harmonized Emissions Component (HEMCO) use modal_aero_calcsize, only: modal_aero_calcsize_init, modal_aero_calcsize_diag, modal_aero_calcsize_reg + use modal_aero_calcsize, only: modal_aero_calcsize_sub use modal_aero_wateruptake, only: modal_aero_wateruptake_init, modal_aero_wateruptake_dr, modal_aero_wateruptake_reg implicit none @@ -909,7 +910,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) endif endif - call cloud_diagnostics_init() + call cloud_diagnostics_init(pbuf2d) call radheat_init(pref_mid) @@ -1948,7 +1949,7 @@ subroutine tphysac (ztodt, cam_in, & ! ! Note: this operation will NOT be reverted with set_wet_to_dry after set_dry_to_wet call ! - call set_dry_to_wet(state) + call set_dry_to_wet(state, convert_cnst_type='dry') if (trim(cam_take_snapshot_before) == "physics_dme_adjust") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& @@ -2067,7 +2068,7 @@ subroutine tphysbc (ztodt, state, & use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng use check_energy, only: tot_energy_phys use dycore, only: dycore_is - use aero_model, only: aero_model_wetdep + use aero_model, only: aero_model_wetdep, wetdep_lq use carma_intr, only: carma_wetdep_tend, carma_timestep_tend use carma_flags_mod, only: carma_do_detrain, carma_do_cldice, carma_do_cldliq, carma_do_wetdep use radiation, only: radiation_tend @@ -2126,7 +2127,6 @@ subroutine tphysbc (ztodt, state, & real(r8) dlf(pcols,pver) ! Detraining cld H20 from shallow + deep convections real(r8) dlf2(pcols,pver) ! Detraining cld H20 from shallow convections - real(r8) pflx(pcols,pverp) ! Conv rain flux thru out btm of lev real(r8) rtdt ! 1./ztodt integer lchnk ! chunk identifier @@ -2327,7 +2327,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_before) == "dadadj_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call dadadj_tend(ztodt, state, ptend) @@ -2340,7 +2340,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_after) == "dadadj_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call t_stopf('dry_adjustment') @@ -2354,12 +2354,12 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_before) == "convect_deep_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call convect_deep_tend( & cmfmc, cmfcme, & - pflx, zdu, & + zdu, & rliq, rice, & ztodt, & state, ptend, cam_in%landfrac, pbuf) @@ -2379,7 +2379,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_after) == "convect_deep_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call t_stopf('convect_deep_tend') @@ -2420,7 +2420,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_before) == "convect_shallow_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call convect_shallow_tend (ztodt , cmfmc, & @@ -2442,7 +2442,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_after) == "convect_shallow_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if flx_cnd(:ncol) = prec_sh(:ncol) + rliq2(:ncol) @@ -2540,7 +2540,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_before) == "macrop_driver_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call macrop_driver_tend( & @@ -2571,7 +2571,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_after) == "macrop_driver_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call check_energy_chng(state, tend, "macrop_tend", nstep, ztodt, & @@ -2587,7 +2587,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_before) == "clubb_tend_cam") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call clubb_tend_cam(state, ptend, pbuf, cld_macmic_ztodt,& @@ -2617,7 +2617,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_after) == "clubb_tend_cam") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if ! Use actual qflux (not lhf/latvap) for consistency with surface fluxes and revised code @@ -2654,7 +2654,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_before) == "microp_section") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call t_startf('microp_aero_run') @@ -2667,7 +2667,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_before) == "microp_driver_tend_subcol") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state_sc, tend_sc, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call microp_driver_tend(state_sc, ptend_sc, cld_macmic_ztodt, pbuf) @@ -2719,7 +2719,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_after) == "microp_driver_tend_subcol") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state_sc, tend_sc, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call check_energy_chng(state_sc, tend_sc, "microp_tend_subcol", & @@ -2751,7 +2751,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_after) == "microp_section") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call check_energy_chng(state, tend, "microp_tend", nstep, ztodt, & @@ -2798,15 +2798,27 @@ subroutine tphysbc (ztodt, state, & ! wet scavenging but not 'convect_deep_tend2'. ! ------------------------------------------------------------------------------- - call t_startf('bc_aerosols') - if (clim_modal_aero .and. .not. prog_modal_aero) then - call modal_aero_calcsize_diag(state, pbuf) - call modal_aero_wateruptake_dr(state, pbuf) + call t_startf('aerosol_wet_processes') + if (clim_modal_aero) then + if (prog_modal_aero) then + call physics_ptend_init(ptend, state%psetcols, 'aero_water_uptake', lq=wetdep_lq) + ! Do calculations of mode radius and water uptake if: + ! 1) modal aerosols are affecting the climate, or + ! 2) prognostic modal aerosols are enabled + call modal_aero_calcsize_sub(state, ptend, ztodt, pbuf) + ! for prognostic modal aerosols the transfer of mass between aitken and accumulation + ! modes is done in conjunction with the dry radius calculation + call modal_aero_wateruptake_dr(state, pbuf) + call physics_update(state, ptend, ztodt, tend) + else + call modal_aero_calcsize_diag(state, pbuf) + call modal_aero_wateruptake_dr(state, pbuf) + endif endif if (trim(cam_take_snapshot_before) == "aero_model_wetdep") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call aero_model_wetdep( state, ztodt, dlf, cam_out, ptend, pbuf) @@ -2818,7 +2830,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_after) == "aero_model_wetdep") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if if (carma_do_wetdep) then @@ -2841,7 +2853,7 @@ subroutine tphysbc (ztodt, state, & ! check tracer integrals call check_tracers_chng(state, tracerint, "cmfmca", nstep, ztodt, zero_tracers) - call t_stopf('bc_aerosols') + call t_stopf('aerosol_wet_processes') endif @@ -2873,7 +2885,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_before) == "radiation_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call radiation_tend( & @@ -2892,7 +2904,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_after) == "radiation_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call check_energy_chng(state, tend, "radheat", nstep, ztodt, zero, zero, zero, net_flx) diff --git a/src/physics/cam/ref_pres.F90 b/src/physics/cam/ref_pres.F90 index f0d5994b81..1630072d3e 100644 --- a/src/physics/cam/ref_pres.F90 +++ b/src/physics/cam/ref_pres.F90 @@ -11,8 +11,11 @@ module ref_pres ! !-------------------------------------------------------------------------- -use shr_kind_mod, only: r8=>shr_kind_r8 -use ppgrid, only: pver, pverp +use shr_kind_mod, only: r8=>shr_kind_r8 +use ppgrid, only: pver, pverp +use cam_history_support, only: add_vert_coord +use cam_logfile, only: iulog +use error_messages, only: alloc_err implicit none public @@ -49,6 +52,11 @@ module ref_pres logical, protected :: do_molec_diff = .false. integer, protected :: nbot_molec = 0 +! Data for the trop_pref coordinate. It is the target of a pointer in a hist_coord_t +! object in the cam_history_support module. It is associated by the call to add_vert_coord. +real(r8), private, allocatable, target :: trop_pref(:) +real(r8), private, allocatable, target :: trop_prefi(:) + !==================================================================================== contains !==================================================================================== @@ -111,6 +119,11 @@ subroutine ref_pres_init(pref_edge_in, pref_mid_in, num_pr_lev_in) real(r8), intent(in) :: pref_edge_in(:) ! reference pressure at layer edges (Pa) real(r8), intent(in) :: pref_mid_in(:) ! reference pressure at layer midpoints (Pa) integer, intent(in) :: num_pr_lev_in ! number of top levels using pure pressure representation + + ! local variables + integer :: nlev + integer :: istat + character(len=*), parameter :: sub = 'ref_pres_init' !--------------------------------------------------------------------------- pref_edge = pref_edge_in @@ -137,6 +150,24 @@ subroutine ref_pres_init(pref_edge_in, pref_mid_in, num_pr_lev_in) top=.false.) end if + ! Add vertical coordinates to history file for use with outputs that are only + ! computed in the subdomain bounded by the top of troposphere clouds. + nlev = pver - trop_cloud_top_lev + 1 + + allocate(trop_pref(nlev), stat=istat) + call alloc_err(istat, sub, 'trop_pref', nlev) + trop_pref = pref_mid(trop_cloud_top_lev:)*0.01_r8 ! convert Pa to hPa + + call add_vert_coord('trop_pref', nlev, 'troposphere reference pressures', & + 'hPa', trop_pref, positive='down') + + allocate(trop_prefi(nlev+1), stat=istat) + call alloc_err(istat, sub, 'trop_prefi', nlev+1) + trop_prefi = pref_edge(trop_cloud_top_lev:)*0.01_r8 ! convert Pa to hPa + + call add_vert_coord('trop_prefi', nlev+1, 'troposphere reference pressures (interfaces)', & + 'hPa', trop_prefi, positive='down') + end subroutine ref_pres_init !==================================================================================== diff --git a/src/physics/cam/subcol_SILHS.F90 b/src/physics/cam/subcol_SILHS.F90 index e7fe38637a..c373ed6b3e 100644 --- a/src/physics/cam/subcol_SILHS.F90 +++ b/src/physics/cam/subcol_SILHS.F90 @@ -19,15 +19,20 @@ module subcol_SILHS #ifdef SILHS use clubb_intr, only: & clubb_config_flags, & - clubb_params, & + clubb_params_single_col, & + stats_metadata, & stats_zt, stats_zm, stats_sfc, & - pdf_params_chnk + pdf_params_chnk, & + hm_metadata, & + hydromet_dim, & + pdf_dim use clubb_api_module, only: & hmp2_ip_on_hmm2_ip_slope_type, & hmp2_ip_on_hmm2_ip_intrcpt_type, & precipitation_fractions, & - stats + stats, & + core_rknd use silhs_api_module, only: & silhs_config_flags_type @@ -58,6 +63,11 @@ module subcol_SILHS type (stats), target :: stats_lh_zt, & stats_lh_sfc !$omp threadprivate(stats_lh_zt, stats_lh_sfc) + + real( kind = core_rknd ), dimension(:,:), allocatable :: & + corr_array_n_cloud, & + corr_array_n_below + #endif !----- @@ -333,10 +343,8 @@ subroutine subcol_init_SILHS(pbuf2d) #ifdef CLUBB_SGS #ifdef SILHS use clubb_api_module, only: core_rknd, & - pdf_dim, & setup_corr_varnce_array_api, & init_pdf_hydromet_arrays_api, & - Ncnp2_on_Ncnm2, & set_clubb_debug_level_api #endif @@ -356,7 +364,6 @@ subroutine subcol_init_SILHS(pbuf2d) ! To set up CLUBB hydromet indices integer :: & - hydromet_dim, & ! Number of enabled hydrometeors iirr, & ! Hydrometeor array index for rain water mixing ratio, rr iirs, & ! Hydrometeor array index for snow mixing ratio, rs iiri, & ! Hydrometeor array index for ice mixing ratio, ri @@ -366,7 +373,7 @@ subroutine subcol_init_SILHS(pbuf2d) iiNi, & ! Hydrometeor array index for ice concentration, Ni iiNg ! Hydrometeor array index for graupel concentration, Ng - integer :: l ! Loop variable + integer :: l, ierr=0 ! Loop variable, error check ! Set CLUBB's debug level ! This is called in module clubb_intr; no need to do it here. @@ -445,36 +452,38 @@ subroutine subcol_init_SILHS(pbuf2d) !------------------------------- iirr = 1 iirs = 3 - iiri = 5 + iiri = 5 iirg = -1 - iiNr = 2 + iiNr = 2 iiNs = 4 - iiNi = 6 + iiNi = 6 iiNg = -1 hydromet_dim = 6 - ! Set up pdf indices, hydromet indicies, hydromet arrays, and hydromet variance ratios - call init_pdf_hydromet_arrays_api( 1.0_core_rknd, 1.0_core_rknd, & ! intent(in) - hydromet_dim, & ! intent(in) - iirr, iiri, iirs, iirg, & ! intent(in) - iiNr, iiNi, iiNs, iiNg, & ! intent(in) - subcol_SILHS_hmp2_ip_on_hmm2_ip_slope, & ! optional(in) - subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt ) ! optional(in) - - Ncnp2_on_Ncnm2 = subcol_SILHS_ncnp2_on_ncnm2 + call init_pdf_hydromet_arrays_api( 1.0_core_rknd, 1.0_core_rknd, hydromet_dim, & ! intent(in) + iirr, iiNr, iiri, iiNi, & ! intent(in) + iirs, iiNs, iirg, iiNg, & ! intent(in) + subcol_SILHS_ncnp2_on_ncnm2, & ! intent(in) + hm_metadata, pdf_dim, & ! intent(out) + subcol_SILHS_hmp2_ip_on_hmm2_ip_slope, & ! optional(in) + subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt ) ! optional(in) !------------------------------- ! Set up hydrometeors and correlation arrays for SILHS !------------------------------- + allocate( corr_array_n_cloud(pdf_dim,pdf_dim), corr_array_n_below(pdf_dim,pdf_dim), stat=ierr) + if( ierr /= 0 ) call endrun(' subcol_init_SILHS: failed to allocate corr_array fields ') + corr_file_path_cloud = trim( subcol_SILHS_corr_file_path )//trim( subcol_SILHS_corr_file_name )//cloud_file_ext corr_file_path_below = trim( subcol_SILHS_corr_file_path )//trim( subcol_SILHS_corr_file_name )//below_file_ext call setup_corr_varnce_array_api( corr_file_path_cloud, corr_file_path_below, & - getnewunit(iunit), & - clubb_config_flags%l_fix_w_chi_eta_correlations ) + pdf_dim, hm_metadata, newunit(iunit), & + clubb_config_flags%l_fix_w_chi_eta_correlations, & ! In + corr_array_n_cloud, corr_array_n_below ) !------------------------------- ! Register output fields from SILHS @@ -599,33 +608,15 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) #ifdef CLUBB_SGS #ifdef SILHS - use clubb_api_module, only : hydromet_dim, & - - setup_pdf_parameters_api, & - - l_stats_samp, & - - hydromet_pdf_parameter, & + use clubb_api_module, only : setup_pdf_parameters_api, & zm2zt_api, setup_grid_heights_api, & - iirr, iiNr, iirs, iiri, & - iirg, iiNs, & - iiNi, iiNg, & - core_rknd, & w_tol_sqd, zero_threshold, & em_min, cloud_frac_min, & ! rc_tol, & - pdf_dim, & - corr_array_n_cloud, & - corr_array_n_below, & - iiPDF_chi, iiPDF_rr, & - iiPDF_w, iiPDF_Nr, & - iiPDF_ri, iiPDF_Ni, & - iiPDF_Ncn, iiPDF_rs, iiPDF_Ns, & - genrand_intg, genrand_init_api, & nparams, ic_K, & @@ -664,7 +655,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) real(r8), parameter :: qsmall = 1.0e-18_r8 ! Microphysics cut-off for cloud integer :: i, j, k, ngrdcol, ncol, lchnk, stncol - integer :: begin_height, end_height ! Output from setup_grid call real(r8) :: sfc_elevation(state%ngrdcol) ! Surface elevation real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: zt_g, zi_g ! Thermo & Momentum grids for clubb @@ -846,6 +836,13 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) type(grid) :: gr type(precipitation_fractions) :: precip_fracs + + ! Used as shortcuts to avoid typing hm_metadata%iiPDF_xx + integer :: & + iiPDF_chi, iiPDF_rr, iiPDF_w, iiPDF_Nr, & + iiPDF_ri, iiPDF_Ni, iiPDF_Ncn, iiPDF_rs, iiPDF_Ns, & + iirr, iiNr, iirs, iiri, & + iirg, iiNs, iiNi, iiNg !------------------------------------------------ ! Begin Code @@ -887,6 +884,26 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ! does not? ! #ERDBG: The model iteration number is not used in SILHS unless ! sequence_length > 1, but nobody runs with that option. + + ! Copy hm_metadata indices to shortcuts + iiPDF_chi = hm_metadata%iiPDF_chi + iiPDF_Ncn = hm_metadata%iiPDF_Ncn + iiPDF_rr = hm_metadata%iiPDF_rr + iiPDF_w = hm_metadata%iiPDF_w + iiPDF_Nr = hm_metadata%iiPDF_Nr + iiPDF_ri = hm_metadata%iiPDF_ri + iiPDF_Ni = hm_metadata%iiPDF_Ni + iiPDF_rs = hm_metadata%iiPDF_rs + iiPDF_Ns = hm_metadata%iiPDF_Ns + iirr = hm_metadata%iirr + iiNr = hm_metadata%iiNr + iirs = hm_metadata%iirs + iiri = hm_metadata%iiri + iirg = hm_metadata%iirg + iiNs = hm_metadata%iiNs + iiNi = hm_metadata%iiNi + iiNg = hm_metadata%iiNg + !---------------- ! Establish associations between pointers and physics buffer fields !---------------- @@ -904,7 +921,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) call pbuf_get_field(pbuf, kvh_idx, khzm_in) ! Pull c_K from clubb parameters. - c_K = clubb_params(ic_K) + c_K = clubb_params_single_col(ic_K) !---------------- ! Copy state and populate numbers and values of sub-columns @@ -957,7 +974,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) call setup_grid_api( pverp+1-top_lev, ncol, sfc_elevation(1:ncol), l_implemented, & ! intent(in) grid_type, zi_g(1:ncol,2), zi_g(1:ncol,1), zi_g(1:ncol,pverp+1-top_lev), & ! intent(in) zi_g(1:ncol,:), zt_g(1:ncol,:), & ! intent(in) - gr, begin_height, end_height ) + gr ) ! Calculate the distance between grid levels on the host model grid, ! using host model grid indices. @@ -1131,26 +1148,28 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) call init_precip_fracs_api( pverp-top_lev+1, ngrdcol, & precip_fracs ) - call setup_pdf_parameters_api( gr, pverp-top_lev+1, ngrdcol, pdf_dim, ztodt, & ! In - Nc_in_cloud, cld_frac_in, khzm, & ! In - ice_supersat_frac_in, hydromet, wphydrometp, & ! In - corr_array_n_cloud, corr_array_n_below, & ! In - pdf_params_chnk(lchnk), l_stats_samp, & ! In - clubb_params, & ! In - clubb_config_flags%iiPDF_type, & ! In - clubb_config_flags%l_use_precip_frac, & ! In - clubb_config_flags%l_predict_upwp_vpwp, & ! In - clubb_config_flags%l_diagnose_correlations, & ! In - clubb_config_flags%l_calc_w_corr, & ! In - clubb_config_flags%l_const_Nc_in_cloud, & ! In - clubb_config_flags%l_fix_w_chi_eta_correlations, & ! In - stats_zt, stats_zm, stats_sfc, & ! In - hydrometp2, & ! Inout - mu_x_1, mu_x_2, & ! Out - sigma_x_1, sigma_x_2, & ! Out - corr_array_1, corr_array_2, & ! Out - corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! Out - precip_fracs ) ! Inout + call setup_pdf_parameters_api( gr, pverp-top_lev+1, ngrdcol, pdf_dim, hydromet_dim, ztodt, & ! In + Nc_in_cloud, cld_frac_in, khzm, & ! In + ice_supersat_frac_in, hydromet, wphydrometp, & ! In + corr_array_n_cloud, corr_array_n_below, & ! In + hm_metadata, & ! In + pdf_params_chnk(lchnk), & ! In + clubb_params_single_col, & ! In + clubb_config_flags%iiPDF_type, & ! In + clubb_config_flags%l_use_precip_frac, & ! In + clubb_config_flags%l_predict_upwp_vpwp, & ! In + clubb_config_flags%l_diagnose_correlations, & ! In + clubb_config_flags%l_calc_w_corr, & ! In + clubb_config_flags%l_const_Nc_in_cloud, & ! In + clubb_config_flags%l_fix_w_chi_eta_correlations, & ! In + stats_metadata, & ! In + stats_zt, stats_zm, stats_sfc, & ! In + hydrometp2, & ! Inout + mu_x_1, mu_x_2, & ! Out + sigma_x_1, sigma_x_2, & ! Out + corr_array_1, corr_array_2, & ! Out + corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! Out + precip_fracs ) ! Inout ! In order for Lscale to be used properly, it needs to be passed out of ! advance_clubb_core, saved to the pbuf, and then pulled out of the @@ -1221,30 +1240,27 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) iter, pdf_dim, num_subcols, sequence_length, pverp-top_lev+1, ngrdcol, & ! In l_calc_weights_all_levs_itime, & ! In pdf_params_chnk(lchnk), delta_zm, Lscale, & ! In - lh_seed, & ! In + lh_seed, hm_metadata, & ! In rho_ds_zt, & ! In mu_x_1, mu_x_2, sigma_x_1, sigma_x_2, & ! In corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! In precip_fracs, silhs_config_flags, & ! In - clubb_params, & ! In - clubb_config_flags%l_uv_nudge, & ! In - clubb_config_flags%l_tke_aniso, & ! In - clubb_config_flags%l_standard_term_ta, & ! In vert_decorr_coef, & ! In - stats_lh_zt, stats_lh_sfc, & ! intent(inout) + stats_metadata, & ! In + stats_lh_zt, stats_lh_sfc, & ! InOut X_nl_all_levs, X_mixt_comp_all_levs, & ! Out lh_sample_point_weights) ! Out ! Extract clipped variables from subcolumns - call clip_transform_silhs_output_api( gr, pverp-top_lev+1, ngrdcol, num_subcols, & ! In - pdf_dim, hydromet_dim, & ! In - X_mixt_comp_all_levs, & ! In - X_nl_all_levs, & ! In - pdf_params_chnk(lchnk), & ! In - l_use_Ncn_to_Nc, & ! In - lh_rt_clipped, lh_thl_clipped, & ! Out - lh_rc_clipped, lh_rv_clipped, & ! Out - lh_Nc_clipped ) ! Out + call clip_transform_silhs_output_api( gr, pverp-top_lev+1, ngrdcol, num_subcols, & ! In + pdf_dim, hydromet_dim, hm_metadata, & ! In + X_mixt_comp_all_levs, & ! In + X_nl_all_levs, & ! In + pdf_params_chnk(lchnk), & ! In + l_use_Ncn_to_Nc, & ! In + lh_rt_clipped, lh_thl_clipped, & ! Out + lh_rc_clipped, lh_rv_clipped, & ! Out + lh_Nc_clipped ) ! Out !$acc wait if ( l_est_kessler_microphys ) then @@ -4125,12 +4141,12 @@ end subroutine subcol_SILHS_hydromet_conc_tend_lim ! small function to get an unused stream identifier to send to setup_corr_varnce_array_api ! or any other silhs/clubb functions that require a unit number argument ! This comes directly from the Fortran wiki - integer function getnewunit(unit) + integer function newunit(unit) integer, intent(out), optional :: unit integer, parameter :: LUN_MIN=10, LUN_MAX=1000 logical :: opened - integer :: lun, newunit + integer :: lun newunit=-1 do lun=LUN_MIN,LUN_MAX @@ -4141,6 +4157,6 @@ integer function getnewunit(unit) end if end do if (present(unit)) unit=newunit - end function getnewunit + end function newunit end module subcol_SILHS diff --git a/src/physics/cam/vertical_diffusion.F90 b/src/physics/cam/vertical_diffusion.F90 index 224d87e3a0..507e99dc8d 100644 --- a/src/physics/cam/vertical_diffusion.F90 +++ b/src/physics/cam/vertical_diffusion.F90 @@ -141,6 +141,8 @@ module vertical_diffusion logical :: waccmx_mode = .false. logical :: do_hb_above_clubb = .false. +real(r8),allocatable :: kvm_sponge(:) + contains ! =============================================================================== ! @@ -280,6 +282,7 @@ subroutine vertical_diffusion_init(pbuf2d) use beljaars_drag_cam, only : beljaars_drag_init use upper_bc, only : ubc_init use phys_control, only : waccmx_is, fv_am_correction + use ref_pres, only : ptop_ref type(physics_buffer_desc), pointer :: pbuf2d(:,:) character(128) :: errstring ! Error status for init_vdiff @@ -289,7 +292,7 @@ subroutine vertical_diffusion_init(pbuf2d) real(r8), parameter :: ntop_eddy_pres = 1.e-7_r8 ! Pressure below which eddy diffusion is not done in WACCM-X. (Pa) - integer :: im, l, m, nmodes, nspec + integer :: im, l, m, nmodes, nspec, ierr logical :: history_amwg ! output the variables used by the AMWG diag package logical :: history_eddy ! output the eddy variables @@ -297,10 +300,48 @@ subroutine vertical_diffusion_init(pbuf2d) integer :: history_budget_histfile_num ! output history file number for budget fields logical :: history_waccm ! output variables of interest for WACCM runs - ! ----------------------------------------------------------------- ! + ! + ! add sponge layer vertical diffusion + ! + if (ptop_ref>1e-1_r8.and.ptop_ref<100.0_r8) then + ! + ! CAM7 FMT (but not CAM6 top (~225 Pa) or CAM7 low top or lower) + ! + allocate(kvm_sponge(4), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'vertical_diffusion_init: kvm_sponge allocation error = ',ierr + call endrun('vertical_diffusion_init: failed to allocate kvm_sponge array') + end if + kvm_sponge(1) = 2E6_r8 + kvm_sponge(2) = 2E6_r8 + kvm_sponge(3) = 0.5E6_r8 + kvm_sponge(4) = 0.1E6_r8 + else if (ptop_ref>1e-4_r8) then + ! + ! WACCM and WACCM-x + ! + allocate(kvm_sponge(6), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'vertical_diffusion_init: kvm_sponge allocation error = ',ierr + call endrun('vertical_diffusion_init: failed to allocate kvm_sponge array') + end if + kvm_sponge(1) = 2E6_r8 + kvm_sponge(2) = 2E6_r8 + kvm_sponge(3) = 1.5E6_r8 + kvm_sponge(4) = 1.0E6_r8 + kvm_sponge(5) = 0.5E6_r8 + kvm_sponge(6) = 0.1E6_r8 + end if if (masterproc) then write(iulog,*)'Initializing vertical diffusion (vertical_diffusion_init)' + if (allocated(kvm_sponge)) then + write(iulog,*)'Artificial sponge layer vertical diffusion added:' + do k=1,size(kvm_sponge(:),1) + write(iulog,'(a44,i2,a17,e7.2,a8)') 'vertical diffusion coefficient at interface',k,' is increased by ', & + kvm_sponge(k),' m2 s-2' + end do + end if !allocated end if ! Check to see if WACCM-X is on (currently we don't care whether the @@ -408,7 +449,7 @@ subroutine vertical_diffusion_init(pbuf2d) do_pbl_diags = .true. call init_hb_diff(gravit, cpair, ntop_eddy, nbot_eddy, pref_mid, karman, eddy_scheme) ! - ! run HB scheme where CLUBB is not active when running cam_dev or cam6 physics + ! run HB scheme where CLUBB is not active when running cam7 or cam6 physics ! else init_hb_diff is called just for diagnostic purposes ! if (do_hb_above_clubb) then @@ -633,7 +674,6 @@ subroutine vertical_diffusion_init(pbuf2d) call pbuf_set_field(pbuf2d, qti_flx_idx, 0.0_r8) end if end if - end subroutine vertical_diffusion_init ! =============================================================================== ! @@ -695,6 +735,7 @@ subroutine vertical_diffusion_tend( & use upper_bc, only : ubc_get_flxs use coords_1d, only : Coords1D use phys_control, only : cam_physpkg_is + use ref_pres, only : ptop_ref ! --------------- ! ! Input Arguments ! @@ -870,7 +911,7 @@ subroutine vertical_diffusion_tend( & ! ----------------------- ! ! Assume 'wet' mixing ratios in diffusion code. - call set_dry_to_wet(state) + call set_dry_to_wet(state, convert_cnst_type='dry') rztodt = 1._r8 / ztodt lchnk = state%lchnk @@ -1016,7 +1057,7 @@ subroutine vertical_diffusion_tend( & case ( 'CLUBB_SGS' ) ! - ! run HB scheme where CLUBB is not active when running cam_dev + ! run HB scheme where CLUBB is not active when running cam7 ! if (do_hb_above_clubb) then call compute_hb_free_atm_diff( ncol , & @@ -1067,6 +1108,14 @@ subroutine vertical_diffusion_tend( & call outfld( 'ustar', ustar(:), pcols, lchnk ) call outfld( 'obklen', obklen(:), pcols, lchnk ) + ! + ! add sponge layer vertical diffusion + ! + if (allocated(kvm_sponge)) then + do k=1,size(kvm_sponge(:),1) + kvm(:ncol,1) = kvm(:ncol,1)+kvm_sponge(k) + end do + end if ! kvh (in pbuf) is used by other physics parameterizations, and as an initial guess in compute_eddy_diff ! on the next timestep. It is not updated by the compute_vdiff call below. @@ -1145,7 +1194,7 @@ subroutine vertical_diffusion_tend( & tauy = 0._r8 shflux = 0._r8 cflux(:,1) = 0._r8 - if (cam_physpkg_is("cam_dev")) then + if (cam_physpkg_is("cam7")) then ! surface fluxes applied in clubb emissions module cflux(:,2:) = 0._r8 else @@ -1335,7 +1384,7 @@ subroutine vertical_diffusion_tend( & endif end do ! convert wet mmr back to dry before conservation check - call set_wet_to_dry(state) + call set_wet_to_dry(state, convert_cnst_type='dry') if (.not. do_pbl_diags) then slten(:ncol,:) = ( sl(:ncol,:) - sl_prePBL(:ncol,:) ) * rztodt @@ -1505,7 +1554,7 @@ subroutine vertical_diffusion_tend( & call outfld( 'KVT' , kvt, pcols, lchnk ) call outfld( 'KVM' , kvm, pcols, lchnk ) call outfld( 'CGS' , cgs, pcols, lchnk ) - dtk(:ncol,:) = dtk(:ncol,:) / cpair ! Normalize heating for history + dtk(:ncol,:) = dtk(:ncol,:) / cpair / ztodt ! Normalize heating for history call outfld( 'DTVKE' , dtk, pcols, lchnk ) dtk(:ncol,:) = ptend%s(:ncol,:) / cpair ! Normalize heating for history using dtk call outfld( 'DTV' , dtk, pcols, lchnk ) diff --git a/src/physics/cam/zm_conv_intr.F90 b/src/physics/cam/zm_conv_intr.F90 index d559ce4be4..b80fcf504d 100644 --- a/src/physics/cam/zm_conv_intr.F90 +++ b/src/physics/cam/zm_conv_intr.F90 @@ -17,7 +17,6 @@ module zm_conv_intr use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_num, rad_cnst_get_aer_mmr, & rad_cnst_get_aer_props, rad_cnst_get_mode_props !, & - use ndrop_bam, only: ndrop_bam_init use cam_abortutils, only: endrun use physconst, only: pi use spmd_utils, only: masterproc @@ -248,6 +247,12 @@ subroutine zm_conv_init(pref_edge) real(r8),intent(in) :: pref_edge(plevp) ! reference pressures at interfaces + ! local variables + real(r8), parameter :: scale_height = 7000._r8 ! std atm scale height (m) + real(r8), parameter :: dz_min = 100._r8 ! minimum thickness for using + ! zmconv_parcel_pbl=.false. + real(r8) :: dz_bot_layer ! thickness of bottom layer (m) + character(len=512) :: errmsg integer :: errflg @@ -351,13 +356,27 @@ subroutine zm_conv_init(pref_edge) ' which is ',pref_edge(limcnv),' pascals' end if + ! If thickness of bottom layer is less than dz_min, and zmconv_parcel_pbl=.false., + ! then issue a warning. + dz_bot_layer = scale_height * log(pref_edge(pverp)/pref_edge(pver)) + if (dz_bot_layer < dz_min .and. .not. zmconv_parcel_pbl) then + if (masterproc) then + write(iulog,*)'********** WARNING **********' + write(iulog,*)' ZM_CONV_INIT: Bottom layer thickness (m) is ', dz_bot_layer + write(iulog,*)' The namelist variable zmconv_parcel_pbl should be set to .true.' + write(iulog,*)' when the bottom layer thickness is < ', dz_min + write(iulog,*)'********** WARNING **********' + end if + end if + no_deep_pbl = phys_deepconv_pbl() !CACNOTE - Need to check errflg and report errors call zm_convr_init(cpair, epsilo, gravit, latvap, tmelt, rair, & limcnv,zmconv_c0_lnd, zmconv_c0_ocn, zmconv_ke, zmconv_ke_lnd, & zmconv_momcu, zmconv_momcd, zmconv_num_cin, zmconv_org, & no_deep_pbl, zmconv_tiedke_add, & - zmconv_capelmt, zmconv_dmpdz,zmconv_parcel_pbl, zmconv_tau, errmsg, errflg) + zmconv_capelmt, zmconv_dmpdz,zmconv_parcel_pbl, zmconv_tau, & + masterproc, iulog, errmsg, errflg) cld_idx = pbuf_get_index('CLD') fracis_idx = pbuf_get_index('FRACIS') @@ -367,7 +386,7 @@ end subroutine zm_conv_init !subroutine zm_conv_tend(state, ptend, tdt) subroutine zm_conv_tend(pblh ,mcon ,cme , & - tpert ,pflx ,zdu , & + tpert ,zdu , & rliq ,rice ,ztodt , & jctop ,jcbot , & state ,ptend_all ,landfrac, pbuf) @@ -399,7 +418,6 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & real(r8), intent(in) :: landfrac(pcols) ! RBN - Landfrac real(r8), intent(out) :: mcon(pcols,pverp) ! Convective mass flux--m sub c - real(r8), intent(out) :: pflx(pcols,pverp) ! scattered precip flux at each level real(r8), intent(out) :: cme(pcols,pver) ! cmf condensation - evaporation real(r8), intent(out) :: zdu(pcols,pver) ! detraining mass flux @@ -474,12 +492,14 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & real(r8) :: md_out(pcols,pver) ! used in momentum transport calculation - real(r8) :: winds(pcols, pver, 2) - real(r8) :: wind_tends(pcols, pver, 2) - real(r8) :: pguall(pcols, pver, 2) - real(r8) :: pgdall(pcols, pver, 2) - real(r8) :: icwu(pcols,pver, 2) - real(r8) :: icwd(pcols,pver, 2) + real(r8) :: pguallu(pcols, pver) + real(r8) :: pguallv(pcols, pver) + real(r8) :: pgdallu(pcols, pver) + real(r8) :: pgdallv(pcols, pver) + real(r8) :: icwuu(pcols,pver) + real(r8) :: icwuv(pcols,pver) + real(r8) :: icwdu(pcols,pver) + real(r8) :: icwdv(pcols,pver) real(r8) :: seten(pcols, pver) logical :: l_windt(2) real(r8) :: tfinal1, tfinal2 @@ -503,7 +523,6 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & ftem = 0._r8 mu_out(:,:) = 0._r8 md_out(:,:) = 0._r8 - wind_tends(:ncol,:pver,:) = 0.0_r8 call physics_state_copy(state,state1) ! copy state to local state1. @@ -561,7 +580,6 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & ptend_loc%s(:,:) = 0._r8 mcon(:,:) = 0._r8 dlf(:,:) = 0._r8 - pflx(:,:) = 0._r8 cme(:,:) = 0._r8 cape(:) = 0._r8 zdu(:,:) = 0._r8 @@ -587,18 +605,19 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & !CACNOTE - Need to check errflg and report errors call zm_convr_run(ncol, pver, & pverp, gravit, latice, cpwv, cpliq, rh2o, & - state%t(:ncol,:), state%q(:ncol,:,1), prec(:ncol), jctop(:ncol), jcbot(:ncol), & - pblh(:ncol), state%zm(:ncol,:), state%phis, state%zi(:ncol,:), ptend_loc%q(:ncol,:,1), & + state%t(:ncol,:), state%q(:ncol,:,1), prec(:ncol), & + pblh(:ncol), state%zm(:ncol,:), state%phis(:ncol), state%zi(:ncol,:), ptend_loc%q(:ncol,:,1), & ptend_loc%s(:ncol,:), state%pmid(:ncol,:), state%pint(:ncol,:), state%pdel(:ncol,:), & .5_r8*ztodt, mcon(:ncol,:), cme(:ncol,:), cape(:ncol), & - tpert(:ncol), dlf(:ncol,:), pflx(:ncol,:), zdu(:ncol,:), rprd(:ncol,:), & + tpert(:ncol), dlf(:ncol,:), zdu(:ncol,:), rprd(:ncol,:), & mu(:ncol,:), md(:ncol,:), du(:ncol,:), eu(:ncol,:), ed(:ncol,:), & dp(:ncol,:), dsubcld(:ncol), jt(:ncol), maxg(:ncol), ideep(:ncol), & ql(:ncol,:), rliq(:ncol), landfrac(:ncol), & - org_ncol(:,:), orgt_ncol(:,:), zm_org2d_ncol(:,:), & + org_ncol(:ncol,:), orgt_ncol(:ncol,:), zm_org2d_ncol(:ncol,:), & dif(:ncol,:), dnlf(:ncol,:), dnif(:ncol,:), & rice(:ncol), errmsg, errflg) + if (zmconv_org) then ptend_loc%q(:,:,ixorg)=orgt_ncol(:ncol,:) zm_org2d(:ncol,:) = zm_org2d_ncol(:ncol,:) @@ -607,6 +626,13 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & lengath = count(ideep > 0) if (lengath > ncol) lengath = ncol ! should not happen, but force it to not be larger than ncol for safety sake + jctop(:) = real(pver,r8) + jcbot(:) = 1._r8 + do i = 1,lengath + jctop(ideep(i)) = real(jt(i), r8) + jcbot(ideep(i)) = real(maxg(i), r8) + end do + call outfld('CAPE', cape, pcols, lchnk) ! RBN - CAPE output ! ! Output fractional occurance of ZM convection @@ -746,33 +772,34 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & call physics_ptend_init(ptend_loc, state1%psetcols, 'zm_conv_momtran_run', ls=.true., lu=.true., lv=.true.) - winds(:ncol,:pver,1) = state1%u(:ncol,:pver) - winds(:ncol,:pver,2) = state1%v(:ncol,:pver) - l_windt(1) = .true. l_windt(2) = .true. +!REMOVECAM - no longer need these when CAM is retired and pcols no longer exists + ptend_loc%s(:,:) = 0._r8 + ptend_loc%u(:,:) = 0._r8 + ptend_loc%v(:,:) = 0._r8 +!REMOVECAM_END call t_startf ('zm_conv_momtran_run') -!REMOVECAM - no longer need this when CAM is retired and pcols no longer exists - wind_tends(:,:,:) = 0._r8 -!REMOVECAM_END - call zm_conv_momtran_run (ncol, pver, pverp, & - l_windt,winds(:ncol,:,:), 2, mu(:ncol,:), md(:ncol,:), & + l_windt,state1%u(:ncol,:), state1%v(:ncol,:), 2, mu(:ncol,:), md(:ncol,:), & zmconv_momcu, zmconv_momcd, & du(:ncol,:), eu(:ncol,:), ed(:ncol,:), dp(:ncol,:), dsubcld(:ncol), & jt(:ncol), maxg(:ncol), ideep(:ncol), 1, lengath, & - nstep, wind_tends(:ncol,:,:), pguall(:ncol,:,:), pgdall(:ncol,:,:), & - icwu(:ncol,:,:), icwd(:ncol,:,:), ztodt, seten(:ncol,:) ) + nstep, ptend_loc%u(:ncol,:), ptend_loc%v(:ncol,:),& + pguallu(:ncol,:), pguallv(:ncol,:), pgdallu(:ncol,:), pgdallv(:ncol,:), & + icwuu(:ncol,:), icwuv(:ncol,:), icwdu(:ncol,:), icwdv(:ncol,:), ztodt, seten(:ncol,:) ) call t_stopf ('zm_conv_momtran_run') - ptend_loc%u(:ncol,:pver) = wind_tends(:ncol,:pver,1) - ptend_loc%v(:ncol,:pver) = wind_tends(:ncol,:pver,2) ptend_loc%s(:ncol,:pver) = seten(:ncol,:pver) call physics_ptend_sum(ptend_loc,ptend_all, ncol) + ! Output ptend variables before they are set to zero with physics_update + call outfld('ZMMTU', ptend_loc%u, pcols, lchnk) + call outfld('ZMMTV', ptend_loc%v, pcols, lchnk) + ! update physics state type state1 with ptend_loc call physics_update(state1, ptend_loc, ztodt) @@ -782,20 +809,18 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & call outfld('ZM_ORG2D', zm_org2d, pcols, lchnk) endif call outfld('ZMMTT', ftem , pcols, lchnk) - call outfld('ZMMTU', wind_tends(1,1,1), pcols, lchnk) - call outfld('ZMMTV', wind_tends(1,1,2), pcols, lchnk) ! Output apparent force from pressure gradient - call outfld('ZMUPGU', pguall(1,1,1), pcols, lchnk) - call outfld('ZMUPGD', pgdall(1,1,1), pcols, lchnk) - call outfld('ZMVPGU', pguall(1,1,2), pcols, lchnk) - call outfld('ZMVPGD', pgdall(1,1,2), pcols, lchnk) + call outfld('ZMUPGU', pguallu, pcols, lchnk) + call outfld('ZMUPGD', pgdallu, pcols, lchnk) + call outfld('ZMVPGU', pguallv, pcols, lchnk) + call outfld('ZMVPGD', pgdallv, pcols, lchnk) ! Output in-cloud winds - call outfld('ZMICUU', icwu(1,1,1), pcols, lchnk) - call outfld('ZMICUD', icwd(1,1,1), pcols, lchnk) - call outfld('ZMICVU', icwu(1,1,2), pcols, lchnk) - call outfld('ZMICVD', icwd(1,1,2), pcols, lchnk) + call outfld('ZMICUU', icwuu, pcols, lchnk) + call outfld('ZMICUD', icwdu, pcols, lchnk) + call outfld('ZMICVU', icwuv, pcols, lchnk) + call outfld('ZMICVD', icwdv, pcols, lchnk) end if diff --git a/src/physics/cam_dev/cam_snapshot.F90 b/src/physics/cam7/cam_snapshot.F90 similarity index 96% rename from src/physics/cam_dev/cam_snapshot.F90 rename to src/physics/cam7/cam_snapshot.F90 index 898bcbf151..360516bd49 100644 --- a/src/physics/cam_dev/cam_snapshot.F90 +++ b/src/physics/cam7/cam_snapshot.F90 @@ -21,7 +21,7 @@ module cam_snapshot use cam_snapshot_common, only: snapshot_type, cam_snapshot_deactivate, cam_snapshot_all_outfld, cam_snapshot_ptend_outfld use cam_snapshot_common, only: snapshot_type, cam_state_snapshot_init, cam_cnst_snapshot_init, cam_tend_snapshot_init use cam_snapshot_common, only: cam_ptend_snapshot_init, cam_in_snapshot_init, cam_out_snapshot_init -use cam_snapshot_common, only: cam_pbuf_snapshot_init, snapshot_addfld +use cam_snapshot_common, only: cam_pbuf_snapshot_init, snapshot_addfld implicit none @@ -58,7 +58,7 @@ subroutine cam_snapshot_init(cam_in_arr, cam_out_arr, pbuf, index) call phys_getopts(cam_snapshot_before_num_out = cam_snapshot_before_num, & cam_snapshot_after_num_out = cam_snapshot_after_num) - + ! Return if not turned on if (cam_snapshot_before_num <= 0 .and. cam_snapshot_after_num <= 0) return ! No snapshot files are being requested @@ -76,7 +76,7 @@ subroutine cam_snapshot_init(cam_in_arr, cam_out_arr, pbuf, index) end subroutine cam_snapshot_init subroutine cam_snapshot_all_outfld_tphysbc(file_num, state, tend, cam_in, cam_out, pbuf, cmfmc, cmfcme, & - pflx, zdu, rliq, rice, dlf, dlf2, rliq2, net_flx) + zdu, rliq, rice, dlf, dlf2, rliq2, net_flx) use time_manager, only: is_first_step, is_first_restart_step @@ -94,7 +94,6 @@ subroutine cam_snapshot_all_outfld_tphysbc(file_num, state, tend, cam_in, cam_ou type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) real(r8), intent(in) :: cmfmc(:,:) ! convective mass flux real(r8), intent(in) :: cmfcme(:,:) ! cmf condensation - evaporation - real(r8), intent(in) :: pflx(:,:) ! convective rain flux throughout bottom of level real(r8), intent(in) :: zdu(:,:) ! detraining mass flux from deep convection real(r8), intent(in) :: rliq(:) ! vertical integral of liquid not yet in q(ixcldliq) real(r8), intent(in) :: rice(:) ! vertical integral of ice not yet in q(ixcldice) @@ -108,14 +107,13 @@ subroutine cam_snapshot_all_outfld_tphysbc(file_num, state, tend, cam_in, cam_ou ! Return if the first timestep as not all fields may be filled in and this will cause a core dump if (is_first_step().or. is_first_restart_step()) return - ! Return if not turned on + ! Return if not turned on if (cam_snapshot_before_num <= 0 .and. cam_snapshot_after_num <= 0) return ! No snapshot files are being requested lchnk = state%lchnk call outfld('tphysbc_cmfmc', cmfmc, pcols, lchnk) call outfld('tphysbc_cmfcme', cmfcme, pcols, lchnk) - call outfld('tphysbc_pflx', pflx, pcols, lchnk) call outfld('tphysbc_zdu', zdu, pcols, lchnk) call outfld('tphysbc_rliq', rliq, pcols, lchnk) call outfld('tphysbc_rice', rice, pcols, lchnk) @@ -160,7 +158,7 @@ subroutine cam_snapshot_all_outfld_tphysac(file_num, state, tend, cam_in, cam_ou ! Return if the first timestep as not all fields may be filled in and this will cause a core dump if (is_first_step()) return - ! Return if not turned on + ! Return if not turned on if (cam_snapshot_before_num <= 0 .and. cam_snapshot_after_num <= 0) return ! No snapshot files are being requested lchnk = state%lchnk @@ -187,7 +185,7 @@ subroutine cam_tphysbc_snapshot_init(cam_snapshot_before_num, cam_snapshot_after !-------------------------------------------------------- integer,intent(in) :: cam_snapshot_before_num, cam_snapshot_after_num - + ntphysbc_var = 0 !-------------------------------------------------------- @@ -204,9 +202,6 @@ subroutine cam_tphysbc_snapshot_init(cam_snapshot_before_num, cam_snapshot_after call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & 'cmfcme', 'tphysbc_cmfcme', 'unset', 'lev') - call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'pflx', 'tphysbc_pflx', 'unset', 'lev') - call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & 'zdu', 'tphysbc_zdu', 'unset', 'lev') @@ -239,7 +234,7 @@ subroutine cam_tphysac_snapshot_init(cam_snapshot_before_num, cam_snapshot_after !-------------------------------------------------------- integer,intent(in) :: cam_snapshot_before_num, cam_snapshot_after_num - + ntphysac_var = 0 !-------------------------------------------------------- diff --git a/src/physics/cam_dev/convect_diagnostics.F90 b/src/physics/cam7/convect_diagnostics.F90 similarity index 100% rename from src/physics/cam_dev/convect_diagnostics.F90 rename to src/physics/cam7/convect_diagnostics.F90 diff --git a/src/physics/cam_dev/micro_pumas_cam.F90 b/src/physics/cam7/micro_pumas_cam.F90 similarity index 97% rename from src/physics/cam_dev/micro_pumas_cam.F90 rename to src/physics/cam7/micro_pumas_cam.F90 index 7c38333e95..f38eda2ade 100644 --- a/src/physics/cam_dev/micro_pumas_cam.F90 +++ b/src/physics/cam7/micro_pumas_cam.F90 @@ -14,6 +14,10 @@ module micro_pumas_cam latvap, latice, mwh2o use phys_control, only: phys_getopts, use_hetfrz_classnuc +use shr_const_mod, only: pi => shr_const_pi +use time_manager, only: get_curr_date, get_curr_calday +use phys_grid, only: get_rlat_all_p, get_rlon_all_p +use orbit, only: zenith use physics_types, only: physics_state, physics_ptend, & physics_ptend_init, physics_state_copy, & @@ -206,6 +210,8 @@ module micro_pumas_cam ast_idx = -1, & cld_idx = -1, & concld_idx = -1, & + prec_dp_idx = -1, & + prec_sh_idx = -1, & qsatfac_idx = -1 ! Pbuf fields needed for subcol_SILHS @@ -1085,6 +1091,10 @@ subroutine micro_pumas_cam_init(pbuf2d) end if + call addfld ('RBFRAC', horiz_only, 'A', 'Fraction', 'Fraction of sky covered by a potential rainbow' ) + call addfld ('RBFREQ', horiz_only, 'A', 'Frequency', 'Potential rainbow frequency' ) + call addfld( 'rbSZA', horiz_only, 'I', 'degrees', 'solar zenith angle' ) + ! History variables for CAM5 microphysics call addfld ('MPDT', (/ 'lev' /), 'A', 'W/kg', 'Heating tendency - Morrison microphysics' ) call addfld ('MPDQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency - Morrison microphysics' ) @@ -1366,6 +1376,8 @@ subroutine micro_pumas_cam_init(pbuf2d) ast_idx = pbuf_get_index('AST') cld_idx = pbuf_get_index('CLD') concld_idx = pbuf_get_index('CONCLD') + prec_dp_idx = pbuf_get_index('PREC_DP') + prec_sh_idx = pbuf_get_index('PREC_SH') naai_idx = pbuf_get_index('NAAI') naai_hom_idx = pbuf_get_index('NAAI_HOM') @@ -1653,6 +1665,9 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) real(r8), pointer :: cld(:,:) ! Total cloud fraction real(r8), pointer :: concld(:,:) ! Convective cloud fraction + real(r8), pointer :: prec_dp(:) ! Deep Convective precip + real(r8), pointer :: prec_sh(:) ! Shallow Convective precip + real(r8), pointer :: iciwpst(:,:) ! Stratiform in-cloud ice water path for radiation real(r8), pointer :: iclwpst(:,:) ! Stratiform in-cloud liquid water path for radiation real(r8), pointer :: cldfsnow(:,:) ! Cloud fraction for liquid+snow @@ -1884,6 +1899,34 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) real(r8), parameter :: mucon = 5.3_r8 ! Convective size distribution shape parameter real(r8), parameter :: deicon = 50._r8 ! Convective ice effective diameter (meters) +! Rainbows: SZA + real(r8) :: zen_angle(state%psetcols) ! Daytime solar zenith angles (radians) + real(r8) :: rlats(state%psetcols), rlons(state%psetcols) ! chunk latitudes and longitudes (radians) + real(r8) :: sza(state%psetcols) ! solar zenith angles (degrees) + real(r8), parameter :: rad2deg = 180._r8/pi ! radians to degrees conversion factor + real(r8) :: calday !current calendar day + + real(r8) :: precc(state%psetcols) ! convective precip rate + +! Rainbow frequency and fraction for output + + real(r8) :: rbfreq(state%psetcols) + real(r8) :: rbfrac(state%psetcols) + +!Rainbows: parameters + + real(r8), parameter :: rb_rmin =1.e-6_r8 ! Strat Rain threshold (mixing ratio) + real(r8), parameter :: rb_rcmin = 5._r8/(86400._r8*1000._r8) ! Conv Rain Threshold (mm/d--> m/s) + real(r8), parameter :: rb_pmin =85000._r8 ! Minimum pressure for surface layer + real(r8), parameter :: deg2rad = pi/180._r8 ! Conversion factor + integer :: top_idx !Index for top level below rb_pmin + real(r8) :: convmx + real(r8) :: cldmx + real(r8) :: frlow + real(r8) :: cldtot + real(r8) :: rmax + logical :: rval + !------------------------------------------------------------------------------- lchnk = state%lchnk @@ -1931,6 +1974,29 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), & col_type=col_type, copy_if_needed=use_subcol_microp) + ! Get convective precip for rainbows + if (prec_dp_idx > 0) then + call pbuf_get_field(pbuf, prec_dp_idx, prec_dp, col_type=col_type, copy_if_needed=use_subcol_microp) + else + nullify(prec_dp) + end if + if (prec_sh_idx > 0) then + call pbuf_get_field(pbuf, prec_sh_idx, prec_sh, col_type=col_type, copy_if_needed=use_subcol_microp) + else + nullify(prec_sh) + end if + +! Merge Precipitation rates (multi-process) + if (associated(prec_dp) .and. associated(prec_sh)) then + precc(:ncol) = prec_dp(:ncol) + prec_sh(:ncol) + else if (associated(prec_dp)) then + precc(:ncol) = prec_dp(:ncol) + else if (associated(prec_sh)) then + precc(:ncol) = prec_sh(:ncol) + else + precc(:ncol) = 0._r8 + end if + if (.not. do_cldice) then ! If we are NOT prognosing ice and snow tendencies, then get them from the Pbuf call pbuf_get_field(pbuf, tnd_qsnow_idx, tnd_qsnow, col_type=col_type, copy_if_needed=use_subcol_microp) @@ -2109,6 +2175,27 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) call pbuf_get_field(pbuf, evpsnow_st_idx, evpsnow_st_grid) call pbuf_get_field(pbuf, am_evp_st_idx, am_evp_st_grid) + !----------------------------------------------------------------------- + ! ... Calculate cosine of zenith angle + ! then cast back to angle (radians) + !----------------------------------------------------------------------- + + zen_angle(:) = 0.0_r8 + rlats(:) = 0.0_r8 + rlons(:) = 0.0_r8 + calday = get_curr_calday() + call get_rlat_all_p( lchnk, ncol, rlats ) + call get_rlon_all_p( lchnk, ncol, rlons ) + call zenith( calday, rlats, rlons, zen_angle, ncol ) + where (zen_angle(:) <= 1.0_r8 .and. zen_angle(:) >= -1.0_r8) + zen_angle(:) = acos( zen_angle(:) ) + elsewhere + zen_angle(:) = 0.0_r8 + end where + + sza(:) = zen_angle(:) * rad2deg + call outfld( 'rbSZA', sza, ncol, lchnk ) + !------------------------------------------------------------------------------------- ! Microphysics assumes 'liquid stratus frac = ice stratus frac ! = max( liquid stratus frac, ice stratus frac )'. @@ -2198,6 +2285,10 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) state_loc_numgraup(:ncol,:) = 0._r8 end if + ! Zero out diagnostic rainbow arrays + rbfreq = 0._r8 + rbfrac = 0._r8 + ! Zero out values above top_lev before passing into _tend for some pbuf variables that are inputs naai(:ncol,:top_lev-1) = 0._r8 npccn(:ncol,:top_lev-1) = 0._r8 @@ -3090,6 +3181,63 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) racau_grid = min(racau_grid, 1.e10_r8) +!----------------------------------------------------------------------- +! Diagnostic Rainbow Calculation. Seriously. +!----------------------------------------------------------------------- + + do i = 1, ngrdcol + + top_idx = pver + convmx = 0._r8 + frlow = 0._r8 + cldmx = 0._r8 + cldtot = maxval(ast(i,top_lev:)) + +! Find levels in surface layer + do k = top_lev, pver + if (state%pmid(i,k) > rb_pmin) then + top_idx = min(k,top_idx) + end if + end do + +!For all fractional precip calculated below, use maximum in surface layer. +!For convective precip, base on convective cloud area + convmx = maxval(concld(i,top_idx:)) +!For stratiform precip, base on precip fraction + cldmx= maxval(freqr(i,top_idx:)) +! Combine and use maximum of strat or conv fraction + frlow= max(cldmx,convmx) + +!max precip + rmax=maxval(qrout_grid(i,top_idx:)) + +! Stratiform precip mixing ratio OR some convective precip +! (rval = true if any sig precip) + + rval = ((precc(i) > rb_rcmin) .or. (rmax > rb_rmin)) + +!Now can find conditions for a rainbow: +! Maximum cloud cover (CLDTOT) < 0.5 +! 48 < SZA < 90 +! freqr (below rb_pmin) > 0.25 +! Some rain (liquid > 1.e-6 kg/kg, convective precip > 1.e-7 m/s + + if ((cldtot < 0.5_r8) .and. (sza(i) > 48._r8) .and. (sza(i) < 90._r8) .and. rval) then + +!Rainbow 'probability' (area) derived from solid angle theory +!as the fraction of the hemisphere for a spherical cap with angle phi=sza-48. +! This is only valid between 48 < sza < 90 (controlled for above). + + rbfrac(i) = max(0._r8,(1._r8-COS((sza(i)-48._r8)*deg2rad))/2._r8) * frlow + rbfreq(i) = 1.0_r8 + end if + + end do ! end column loop for rainbows + + call outfld('RBFRAC', rbfrac, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('RBFREQ', rbfreq, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + + ! --------------------- ! ! History Output Fields ! ! --------------------- ! diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam7/physpkg.F90 similarity index 98% rename from src/physics/cam_dev/physpkg.F90 rename to src/physics/cam7/physpkg.F90 index 46805c150e..d6b23c0fdf 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam7/physpkg.F90 @@ -32,6 +32,7 @@ module physpkg use camsrfexch, only: cam_export use modal_aero_calcsize, only: modal_aero_calcsize_init, modal_aero_calcsize_diag, modal_aero_calcsize_reg + use modal_aero_calcsize, only: modal_aero_calcsize_sub use modal_aero_wateruptake, only: modal_aero_wateruptake_init, modal_aero_wateruptake_dr, modal_aero_wateruptake_reg implicit none @@ -887,7 +888,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) endif endif - call cloud_diagnostics_init() + call cloud_diagnostics_init(pbuf2d) call radheat_init(pref_mid) @@ -1399,7 +1400,7 @@ subroutine tphysac (ztodt, cam_in, & use radiation, only: radiation_tend use tropopause, only: tropopause_output use cam_diagnostics, only: diag_phys_writeout, diag_conv, diag_clip_tend_writeout - use aero_model, only: aero_model_wetdep + use aero_model, only: aero_model_wetdep, wetdep_lq use physics_buffer, only: col_type_subcol use check_energy, only: check_energy_timestep_init use carma_intr, only: carma_wetdep_tend, carma_timestep_tend, carma_emission_tend @@ -1921,10 +1922,22 @@ subroutine tphysac (ztodt, cam_in, & ! wet scavenging but not 'convect_deep_tend2'. ! ------------------------------------------------------------------------------- - call t_startf('bc_aerosols') - if (clim_modal_aero .and. .not. prog_modal_aero) then - call modal_aero_calcsize_diag(state, pbuf) - call modal_aero_wateruptake_dr(state, pbuf) + call t_startf('aerosol_wet_processes') + if (clim_modal_aero) then + if (prog_modal_aero) then + call physics_ptend_init(ptend, state%psetcols, 'aero_water_uptake', lq=wetdep_lq) + ! Do calculations of mode radius and water uptake if: + ! 1) modal aerosols are affecting the climate, or + ! 2) prognostic modal aerosols are enabled + call modal_aero_calcsize_sub(state, ptend, ztodt, pbuf) + ! for prognostic modal aerosols the transfer of mass between aitken and accumulation + ! modes is done in conjunction with the dry radius calculation + call modal_aero_wateruptake_dr(state, pbuf) + call physics_update(state, ptend, ztodt, tend) + else + call modal_aero_calcsize_diag(state, pbuf) + call modal_aero_wateruptake_dr(state, pbuf) + endif endif if (trim(cam_take_snapshot_before) == "aero_model_wetdep") then @@ -1966,7 +1979,7 @@ subroutine tphysac (ztodt, cam_in, & ! check tracer integrals call check_tracers_chng(state, tracerint, "cmfmca", nstep, ztodt, zero_tracers) - call t_stopf('bc_aerosols') + call t_stopf('aerosol_wet_processes') endif @@ -2395,7 +2408,7 @@ subroutine tphysac (ztodt, cam_in, & ! ! Note: this operation will NOT be reverted with set_wet_to_dry after set_dry_to_wet call ! - call set_dry_to_wet(state) + call set_dry_to_wet(state, convert_cnst_type='dry') if (trim(cam_take_snapshot_before) == "physics_dme_adjust") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& @@ -2543,7 +2556,6 @@ subroutine tphysbc (ztodt, state, & real(r8) dlf(pcols,pver) ! Detraining cld H20 from shallow + deep convections real(r8) dlf2(pcols,pver) ! Detraining cld H20 from shallow convections - real(r8) pflx(pcols,pverp) ! Conv rain flux thru out btm of lev real(r8) rtdt ! 1./ztodt integer lchnk ! chunk identifier @@ -2735,7 +2747,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_before) == "dadadj_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & - cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, net_flx) + cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, net_flx) end if call dadadj_tend(ztodt, state, ptend) @@ -2748,7 +2760,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_after) == "dadadj_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & - cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, net_flx) + cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, net_flx) end if call t_stopf('dry_adjustment') @@ -2762,12 +2774,12 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_before) == "convect_deep_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & - cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, net_flx) + cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, net_flx) end if call convect_deep_tend( & cmfmc, cmfcme, & - pflx, zdu, & + zdu, & rliq, rice, & ztodt, & state, ptend, cam_in%landfrac, pbuf) @@ -2787,7 +2799,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_after) == "convect_deep_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & - cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, net_flx) + cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, net_flx) end if call t_stopf('convect_deep_tend') @@ -2828,7 +2840,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_before) == "convect_diagnostics_calc") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & - cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, net_flx) + cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, net_flx) end if call convect_diagnostics_calc (ztodt , cmfmc, & dlf , dlf2 , rliq , rliq2, & diff --git a/src/physics/cam_dev/stochastic_emulated_cam.F90 b/src/physics/cam7/stochastic_emulated_cam.F90 similarity index 100% rename from src/physics/cam_dev/stochastic_emulated_cam.F90 rename to src/physics/cam7/stochastic_emulated_cam.F90 diff --git a/src/physics/cam_dev/stochastic_tau_cam.F90 b/src/physics/cam7/stochastic_tau_cam.F90 similarity index 100% rename from src/physics/cam_dev/stochastic_tau_cam.F90 rename to src/physics/cam7/stochastic_tau_cam.F90 diff --git a/src/physics/carma/base b/src/physics/carma/base new file mode 160000 index 0000000000..bf165cd84e --- /dev/null +++ b/src/physics/carma/base @@ -0,0 +1 @@ +Subproject commit bf165cd84ef94087d9a5669a5ad47838ab24c0ef diff --git a/src/physics/carma/cam/carma_intr.F90 b/src/physics/carma/cam/carma_intr.F90 index ec935e29b4..03d7ca5fab 100644 --- a/src/physics/carma/cam/carma_intr.F90 +++ b/src/physics/carma/cam/carma_intr.F90 @@ -1036,7 +1036,7 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli ! The CARMA interface assumes that mass mixing ratios are relative to a ! wet atmosphere, so convert any dry mass mixing ratios to wet. call physics_state_copy(state, state_loc) - call set_dry_to_wet(state_loc) + call set_dry_to_wet(state_loc, convert_cnst_type='dry') spdiags(:, :, :) = 0.0_r8 gpdiags(:, :, :, :) = 0.0_r8 diff --git a/src/physics/carma/models/cirrus/carma_cloudfraction.F90 b/src/physics/carma/models/cirrus/carma_cloudfraction.F90 index 88be7373bb..0ec202041f 100644 --- a/src/physics/carma/models/cirrus/carma_cloudfraction.F90 +++ b/src/physics/carma/models/cirrus/carma_cloudfraction.F90 @@ -24,8 +24,7 @@ subroutine CARMA_CloudFraction(carma, cstate, cam_in, state, icol, cldfrc, rhcri use carma_mod use shr_kind_mod, only: r8 => shr_kind_r8 - use physics_types, only: physics_state, physics_ptend, set_wet_to_dry, & - set_dry_to_wet + use physics_types, only: physics_state, physics_ptend use constituents, only: cnst_get_ind use cam_abortutils, only: endrun diff --git a/src/physics/carma/models/cirrus_dust/carma_cloudfraction.F90 b/src/physics/carma/models/cirrus_dust/carma_cloudfraction.F90 index 88be7373bb..0ec202041f 100644 --- a/src/physics/carma/models/cirrus_dust/carma_cloudfraction.F90 +++ b/src/physics/carma/models/cirrus_dust/carma_cloudfraction.F90 @@ -24,8 +24,7 @@ subroutine CARMA_CloudFraction(carma, cstate, cam_in, state, icol, cldfrc, rhcri use carma_mod use shr_kind_mod, only: r8 => shr_kind_r8 - use physics_types, only: physics_state, physics_ptend, set_wet_to_dry, & - set_dry_to_wet + use physics_types, only: physics_state, physics_ptend use constituents, only: cnst_get_ind use cam_abortutils, only: endrun diff --git a/src/physics/clubb b/src/physics/clubb new file mode 160000 index 0000000000..15e802092f --- /dev/null +++ b/src/physics/clubb @@ -0,0 +1 @@ +Subproject commit 15e802092f65b3a20e5d67cb32d40f8a2771ca9b diff --git a/src/physics/cosp2/src b/src/physics/cosp2/src new file mode 160000 index 0000000000..34d8eef3d2 --- /dev/null +++ b/src/physics/cosp2/src @@ -0,0 +1 @@ +Subproject commit 34d8eef3d231a87c0f73e565f6b5d548876b294a diff --git a/src/physics/pumas b/src/physics/pumas new file mode 160000 index 0000000000..84f27d8042 --- /dev/null +++ b/src/physics/pumas @@ -0,0 +1 @@ +Subproject commit 84f27d804207e79e344e8deec98b471207f9b1f0 diff --git a/src/physics/pumas-frozen b/src/physics/pumas-frozen new file mode 160000 index 0000000000..be3cad3a12 --- /dev/null +++ b/src/physics/pumas-frozen @@ -0,0 +1 @@ +Subproject commit be3cad3a12d25918f5016b509b15057f84aab608 diff --git a/src/physics/rrtmgp/data b/src/physics/rrtmgp/data new file mode 160000 index 0000000000..df02975ab9 --- /dev/null +++ b/src/physics/rrtmgp/data @@ -0,0 +1 @@ +Subproject commit df02975ab93165b34a59f0d04b4ae6148fe5127c diff --git a/src/physics/rrtmgp/ext b/src/physics/rrtmgp/ext new file mode 160000 index 0000000000..4d8c5df4c6 --- /dev/null +++ b/src/physics/rrtmgp/ext @@ -0,0 +1 @@ +Subproject commit 4d8c5df4c63434aaab854afd1b02f5986d41dfb3 diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 18488bedb7..ce9e86fa93 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -453,6 +453,7 @@ subroutine radiation_init(pbuf2d) ! pressure interfaces below 1 Pa. When the entire model atmosphere is ! below 1 Pa then an extra layer is added to the top of the model for ! the purpose of the radiation calculation. + nlay = count( pref_edge(:) > 1._r8 ) ! pascals (0.01 mbar) if (nlay == pverp) then @@ -461,6 +462,14 @@ subroutine radiation_init(pbuf2d) ktopcam = 1 ktoprad = 2 nlaycam = pver + else if (nlay == (pverp-1)) then + ! Special case nlay == (pverp-1) -- topmost interface outside bounds (CAM MT config), treat as if it is ok. + ktopcam = 1 + ktoprad = 2 + nlaycam = pver + nlay = nlay+1 ! reassign the value so later code understands to treat this case like nlay==pverp + write(iulog,*) 'RADIATION_INIT: Special case of 1 model interface at p < 1Pa. Top layer will be INCLUDED in radiation calculation.' + write(iulog,*) 'RADIATION_INIT: nlay = ',nlay, ' same as pverp: ',nlay==pverp else ! nlay < pverp. nlay layers are used in radiation calcs, and they are ! all CAM layers. @@ -468,7 +477,7 @@ subroutine radiation_init(pbuf2d) ktoprad = 1 nlaycam = nlay end if - + ! Create lowercase version of the gaslist for RRTMGP. The ty_gas_concs objects ! work with CAM's uppercase names, but other objects that get input from the gas ! concs objects don't work. @@ -1155,9 +1164,13 @@ subroutine radiation_tend( & ! Compute the gas optics (stored in atm_optics_sw). ! toa_flux is the reference solar source from RRTMGP data. + !$acc data copyin(kdist_sw,pmid_day,pint_day,t_day,gas_concs_sw) & + !$acc copy(atm_optics_sw) & + !$acc copyout(toa_flux) errmsg = kdist_sw%gas_optics( & pmid_day, pint_day, t_day, gas_concs_sw, atm_optics_sw, & toa_flux) + !$acc end data call stop_on_err(errmsg, sub, 'kdist_sw%gas_optics') ! Scale the solar source @@ -1174,6 +1187,17 @@ subroutine radiation_tend( & if (nday > 0) then + !! ADDED by SS as part of RRTMGP data optimization + !$acc data copyin(atm_optics_sw, toa_flux, & + !$acc aer_sw, cloud_sw, & + !$acc aer_sw%tau, aer_sw%ssa, aer_sw%g, & + !$acc atm_optics_sw%tau, & + !$acc atm_optics_sw%ssa, atm_optics_sw%g, & + !$acc cloud_sw%tau, cloud_sw%ssa, cloud_sw%g, & + !$acc alb_dir, alb_dif,coszrs_day) & + !$acc copy(fswc, fswc%flux_net,fswc%flux_up,fswc%flux_dn, & + !$acc fsw, fsw%flux_net, fsw%flux_up, fsw%flux_dn) + ! Increment the gas optics (in atm_optics_sw) by the aerosol optics in aer_sw. errmsg = aer_sw%increment(atm_optics_sw) call stop_on_err(errmsg, sub, 'aer_sw%increment') @@ -1193,6 +1217,7 @@ subroutine radiation_tend( & atm_optics_sw, top_at_1, coszrs_day, toa_flux, & alb_dir, alb_dif, fsw) call stop_on_err(errmsg, sub, 'all-sky rte_sw') + !$acc end data end if @@ -1249,14 +1274,36 @@ subroutine radiation_tend( & call rrtmgp_set_gases_lw(icall, state, pbuf, nlay, gas_concs_lw) ! Compute the gas optics and Planck sources. + !$acc data copyin(kdist_lw,pmid_rad,pint_rad,t_rad,t_sfc, & + !$acc gas_concs_lw) & + !$acc copy(atm_optics_lw, & + !$acc atm_optics_lw%tau, sources_lw, & + !$acc sources_lw%lay_source, sources_lw%sfc_source, & + !$acc sources_lw%lev_source_inc, sources_lw%lev_source_dec, & + !$acc sources_lw%sfc_source_jac) errmsg = kdist_lw%gas_optics( & pmid_rad, pint_rad, t_rad, t_sfc, gas_concs_lw, & atm_optics_lw, sources_lw) call stop_on_err(errmsg, sub, 'kdist_lw%gas_optics') + !$acc end data ! Set LW aerosol optical properties in the aer_lw object. call rrtmgp_set_aer_lw(icall, state, pbuf, aer_lw) + !! Added by SS as part of RRTMGP data optimization + !$acc data copyin(atm_optics_lw, aer_lw, cloud_lw, & + !$acc aer_lw%tau, & + !$acc atm_optics_lw%tau, & + !$acc cloud_lw%tau, & + !$acc sources_lw, & + !$acc sources_lw%lay_source, sources_lw%sfc_source, & + !$acc sources_lw%lev_source_inc, sources_lw%lev_source_dec, & + !$acc sources_lw%sfc_source_Jac, & + !$acc emis_sfc) & + !$acc copy(flwc, flwc%flux_net,flwc%flux_up,flwc%flux_dn, & + !$acc flw, flw%flux_net, flw%flux_up, flw%flux_dn) + + ! Increment the gas optics by the aerosol optics. errmsg = aer_lw%increment(atm_optics_lw) call stop_on_err(errmsg, sub, 'aer_lw%increment') @@ -1272,6 +1319,7 @@ subroutine radiation_tend( & ! Compute all-sky LW fluxes errmsg = rte_lw(atm_optics_lw, top_at_1, sources_lw, emis_sfc, flw) call stop_on_err(errmsg, sub, 'all-sky rte_lw') + !$acc end data ! Transform RRTMGP outputs to CAM outputs and compute heating rates. call set_lw_diags() diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 index 2f2b125e09..4f73ae9029 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -150,11 +150,20 @@ subroutine rrtmgp_set_state( & ! Add extra layer values if needed. if (nlay == pverp) then - t_rad(:,1) = state%t(:ncol,1) - pmid_rad(:,1) = 0.5_r8 * state%pint(:ncol,1) + t_rad(:,1) = state%t(:ncol,1) ! The top reference pressure from the RRTMGP coefficients datasets is 1.005183574463 Pa ! Set the top of the extra layer just below that. pint_rad(:,1) = 1.01_r8 + + ! next interface down in LT will always be > 1Pa + ! but in MT we apply adjustment to have it be 1.02 Pa if it was too high + where (pint_rad(:,2) <= pint_rad(:,1)) pint_rad(:,2) = pint_rad(:,1)+0.01_r8 + + ! set the highest pmid (in the "extra layer") to the midpoint (guarantees > 1Pa) + pmid_rad(:,1) = pint_rad(:,1) + 0.5_r8 * (pint_rad(:,2) - pint_rad(:,1)) + + ! For case of CAM MT, also ensure pint_rad(:,2) > pint_rad(:,1) & pmid_rad(:,2) > max(pmid_rad(:,1), min_pressure) + where (pmid_rad(:,2) <= kdist_sw%get_press_min()) pmid_rad(:,2) = pint_rad(:,2) + 0.01_r8 else ! nlay < pverp, thus the 1 Pa level is within a CAM layer. Assuming the top interface of ! this layer is at a pressure < 1 Pa, we need to adjust the top of this layer so that it diff --git a/src/physics/simple/physpkg.F90 b/src/physics/simple/physpkg.F90 index a296fd2fdb..8c9c1586ef 100644 --- a/src/physics/simple/physpkg.F90 +++ b/src/physics/simple/physpkg.F90 @@ -654,7 +654,7 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) ! ! Note: this operation will NOT be reverted with set_wet_to_dry after set_dry_to_wet call ! - call set_dry_to_wet(state) + call set_dry_to_wet(state, convert_cnst_type='dry') call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) call tot_energy_phys(state, 'phAM') call tot_energy_phys(state, 'dyAM', vc=vc_dycore) diff --git a/src/physics/simple/tj2016.F90 b/src/physics/simple/tj2016.F90 deleted file mode 100644 index 5f46b13e2d..0000000000 --- a/src/physics/simple/tj2016.F90 +++ /dev/null @@ -1,582 +0,0 @@ -module TJ2016 - !------------------------------------------------------------------------------------ - ! - ! Purpose: Implement idealized moist Held-Suarez forcings described in the TJ16 paper - ! Thatcher, D. R. and C. Jablonowski (2016), - ! "A moist aquaplanet variant of the Held-Suarez test - ! for atmospheric model dynamical cores", - ! Geosci. Model Dev., Vol. 9, 1263-1292, - ! doi:10.5194/gmd-9-1263-2016 - ! - ! The moist simplified physics processes are based on the paper by - ! Reed, K. A. and C. Jablonowski (2012), "Idealized tropical - ! cyclone simulations of intermediate complexity: A test case - ! for AGCMs", J. Adv. Model. Earth Syst., Vol. 4, M04001, - ! doi:10.1029/2011MS000099 - ! - ! The default configuration of this routine selects the - ! moist Held-Suarez forcing (TJ16_moist_HS). The routine can also be changed - ! to select the Reed-Jablonowski (RJ) "simple-physics" forcing for e.g. an - ! idealized tropical cyclone simulation. - ! The switch is implemented via the variable: - ! simple_physics_option = "TJ16" (default, moist Held-Suarez) - ! or - ! simple_physics_option = "RJ12" (optional, alternative setting) - !----------------------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use shr_const_mod, only: pi => shr_const_pi - - implicit none - private - save - - public :: Thatcher_Jablonowski_set_const ! Store constants - public :: Thatcher_Jablonowski_precip ! Moist physics - public :: Thatcher_Jablonowski_sfc_pbl_hs ! Surface, PBL and Held-Suarez - - ! Private data - real(r8) :: gravit ! g: gravitational acceleration (m/s2) - real(r8) :: cappa ! Rd/cp - real(r8) :: rair ! Rd: dry air gas constant (J/K/kg) - real(r8) :: cpair ! cp: specific heat of dry air (J/K/kg) - real(r8) :: latvap ! L: latent heat of vaporization (J/kg) - real(r8) :: rh2o ! Rv: water vapor gas constant (J/K/kg) - real(r8) :: epsilo ! Rd/Rv: ratio of h2o to dry air molecular weights - real(r8) :: rhoh2o ! density of liquid water (kg/m3) - real(r8) :: zvir ! (rh2o/rair) - 1, needed for virtual temperaturr - real(r8) :: ps0 ! Base state surface pressure (Pa) - real(r8), allocatable :: etamid(:) ! hybrid coordinate - midpoints - -CONTAINS - - subroutine Thatcher_Jablonowski_set_const(gravit_in, cappa_in, rair_in, & - cpair_in, latvap_in, rh2o_in, epsilo_in, rhoh2o_in, zvir_in, ps0_in, etamid_in) - real(r8), intent(in) :: gravit_in - real(r8), intent(in) :: cappa_in - real(r8), intent(in) :: rair_in - real(r8), intent(in) :: cpair_in - real(r8), intent(in) :: latvap_in - real(r8), intent(in) :: rh2o_in - real(r8), intent(in) :: epsilo_in - real(r8), intent(in) :: rhoh2o_in - real(r8), intent(in) :: zvir_in - real(r8), intent(in) :: ps0_in - real(r8), intent(in) :: etamid_in(:) - - gravit = gravit_in - cappa = cappa_in - rair = rair_in - cpair = cpair_in - latvap = latvap_in - rh2o = rh2o_in - epsilo = epsilo_in - rhoh2o = rhoh2o_in - zvir = zvir_in - ps0 = ps0_in - - allocate(etamid(size(etamid_in))) - etamid = etamid_in - - end subroutine Thatcher_Jablonowski_set_const - - -!======================================================================= -! Moist processes -!======================================================================= - subroutine Thatcher_Jablonowski_precip(ncol, pver, dtime, & - pmid, pdel, T, qv, relhum, precl, precc) - !------------------------------------------------ - ! Input / output parameters - !------------------------------------------------ - - integer, intent(in) :: ncol ! number of columns - integer, intent(in) :: pver ! number of vertical levels - real(r8), intent(in) :: dtime ! time step (s) - real(r8), intent(in) :: pmid(ncol,pver) ! mid-point pressure (Pa) - real(r8), intent(in) :: pdel(ncol,pver) ! layer thickness (Pa) - - real(r8), intent(inout) :: T(ncol,pver) ! temperature (K) - real(r8), intent(inout) :: qv(ncol,pver) ! specific humidity Q (kg/kg) - - real(r8), intent(out) :: relhum(ncol,pver) ! relative humidity - real(r8), intent(out) :: precl(ncol) ! large-scale precipitation rate (m/s) - real(r8), intent(out) :: precc(ncol) ! convective precipitation (m/s) (optional) - - !------------------------------------------------ - ! Local variables - !------------------------------------------------ - - ! Simple physics specific constants and variables - - real(r8), parameter :: T0=273.16_r8 ! control temperature (K) for calculation of qsat - real(r8), parameter :: e0=610.78_r8 ! saturation vapor pressure (Pa) at T0 for calculation of qsat - - ! Variables for condensation and precipitation - real(r8) :: qsat ! saturation value for Q (kg/kg) - real(r8) :: tmp, tmp_t, tmp_q - ! Loop variables - integer :: i, k - - !========================================================================== - ! Set intial total, convective, and large scale precipitation rates to zero - !========================================================================== - precc = 0.0_r8 - precl = 0.0_r8 - - !========================================================================= - ! Placeholder location for an optional deep convection parameterization (not included here) - !========================================================================= - ! An example could be the simplified Betts-Miller (SBM) convection - ! parameterization described in Frierson (JAS, 2007). - ! The parameterization is expected to update - ! the convective precipitation rate precc and the temporary state variables - ! T and qv. T and qv will then be updated again with the - ! large-scale condensation process below. - - !========================================================================= - ! Large-Scale Condensation and Precipitation without cloud stage - !========================================================================= - do k = 1, pver - do i = 1, ncol - qsat = epsilo*e0/pmid(i,k)*exp(-latvap/rh2o*((1._r8/T(i,k))-1._r8/T0)) ! saturation value for Q - if (qv(i,k) > qsat) then - ! if > 100% relative humidity rain falls out - tmp = 1._r8/dtime*(qv(i,k)-qsat)/(1._r8+(latvap/cpair)*(epsilo*latvap*qsat/(rair*T(i,k)**2))) ! condensation rate - tmp_t = latvap/cpair*tmp ! dT/dt tendency from large-scale condensation - tmp_q = -tmp ! dqv/dt tendency from large-scale condensation - precl(i) = precl(i) + tmp*pdel(i,k)/(gravit*rhoh2o) ! large-scale precipitation rate (m/s) - T(i,k) = T(i,k) + tmp_t*dtime ! update T (temperature) - qv(i,k) = qv(i,k) + tmp_q*dtime ! update qv (specific humidity) - ! recompute qsat with updated T - qsat = epsilo*e0/pmid(i,k)*exp(-latvap/rh2o*((1._r8/T(i,k))-1._r8/T0)) ! saturation value for Q - end if - - relhum(i,k) = qv(i,k) / qsat * 100._r8 ! in percent - - end do - end do - - end subroutine Thatcher_Jablonowski_precip - - -!======================================================================= -! Surface fluxes and planetary boundary layer parameterization -!======================================================================= - subroutine Thatcher_Jablonowski_sfc_pbl_hs(ncol, pver, dtime, clat, & - PS, pmid, pint, lnpint, rpdel, T, U, V, qv, shflx, lhflx, taux, tauy, & - evap, dqdt_vdiff, dtdt_vdiff, dtdt_heating, Km, Ke, Tsurf) - !------------------------------------------------ - ! Input / output parameters - !------------------------------------------------ - - integer, intent(in) :: ncol ! number of columns - integer, intent(in) :: pver ! number of vertical levels - real(r8), intent(in) :: dtime ! time step (s) - real(r8), intent(in) :: clat(ncol) ! latitude - real(r8), intent(in) :: PS(ncol) ! surface pressure (Pa) - real(r8), intent(in) :: pmid(ncol,pver) ! mid-point pressure (Pa) - real(r8), intent(in) :: pint(ncol,pver+1) ! interface pressure (Pa) - real(r8), intent(in) :: lnpint(ncol,2) ! ln(interface pressure (Pa)) at and above the surface - real(r8), intent(in) :: rpdel(ncol,pver) ! reciprocal of layer thickness (Pa) - - real(r8), intent(inout) :: T(ncol,pver) ! temperature (K) - real(r8), intent(inout) :: U(ncol,pver) ! zonal wind (m/s) - real(r8), intent(inout) :: V(ncol,pver) ! meridional wind (m/s) - real(r8), intent(inout) :: qv(ncol,pver) ! moisture variable (vapor form) Q (kg/kg) - - real(r8), intent(out) :: shflx(ncol) ! surface sensible heat flux (W/m2) - real(r8), intent(out) :: lhflx(ncol) ! surface latent heat flux (W/m2) - real(r8), intent(out) :: taux(ncol) ! surface momentum flux in the zonal direction (N/m2) - real(r8), intent(out) :: tauy(ncol) ! surface momentum flux in the meridional direction (N/m2) - real(r8), intent(out) :: evap(ncol) ! surface water flux (kg/m2/s) - real(r8), intent(out) :: dqdt_vdiff(ncol,pver) ! Q tendency due to vertical diffusion (PBL) (kg/kg/s) - real(r8), intent(out) :: dtdt_vdiff(ncol,pver) ! T tendency due to vertical diffusion (PBL) in K/s - real(r8), intent(out) :: dtdt_heating(ncol,pver) ! temperature tendency in K/s from relaxation - real(r8), intent(out) :: Km(ncol,pver+1) ! Eddy diffusivity for boundary layer calculations - real(r8), intent(out) :: Ke(ncol,pver+1) ! Eddy diffusivity for boundary layer calculations - real(r8), intent(out) :: Tsurf(ncol) ! sea surface temperature K (varied by latitude) - - !------------------------------------------------ - ! Local variables - !------------------------------------------------ - - ! Constants and variables for the modified Held-Suarez forcing - real(r8), parameter :: sec_per_day = 86400._r8 ! number of seconds per day - real(r8), parameter :: kf=1._r8/( 1._r8*sec_per_day) ! 1./efolding_time for wind dissipation (1/s) - real(r8), parameter :: ka=1._r8/(40._r8*sec_per_day) ! 1./efolding_time for temperature diss. (1/s) - real(r8), parameter :: ks=1._r8/( 4._r8*sec_per_day) ! 1./efolding_time for temperature diss. (1/s) - real(r8), parameter :: sigmab=0.7_r8 ! threshold sigma level (PBL level) - real(r8), parameter :: onemsig=1._r8-sigmab ! 1. - sigma_reference - real(r8), parameter :: t00 = 200._r8 ! minimum reference temperature (K) - real(r8), parameter :: t_max=294._r8 ! modified maximum HS equilibrium temperature (HS original is 315 K) - real(r8), parameter :: delta_T=65._r8 ! difference in eq-polar HS equilibrium temperature (HS original is 60 K) - real(r8), parameter :: delta_theta=10._r8 ! parameter for vertical temperature gradient (K) - real(r8) :: kv ! 1./efolding_time (normalized) for wind (1/s) - real(r8) :: kt ! 1./efolding_time for temperature diss. (1/s) - real(r8) :: trefa ! "radiative equilibrium" T (K) - real(r8) :: trefc ! used in calc of "radiative equilibrium" T - - ! Trig functions - real(r8) :: cossq(ncol) ! coslat**2 - real(r8) :: cossqsq(ncol) ! coslat**4 - real(r8) :: sinsq(ncol) ! sinlat**2 - real(r8) :: coslat(ncol) ! cosine(latitude) - - ! Simplified physics: constants - real(r8), parameter :: T_min = 271._r8 ! Minimum sea surface temperature (K) - real(r8), parameter :: del_T = 29._r8 ! difference in eq-polar sea surface temperature (K) - real(r8), parameter :: T_width = 26.0_r8*pi/180.0_r8 ! width parameter for sea surface temperature (C) - real(r8), parameter :: Tsurf_RJ12 = 302.15_r8 ! constant sea surface temperature (K) for RJ12 - - real(r8), parameter :: T0=273.16_r8 ! Control temperature (K) for calculation of qsat - real(r8), parameter :: e0=610.78_r8 ! Saturation vapor pressure (Pa) at T0 for calculation of qsat - real(r8), parameter :: Cd0=0.0007_r8 ! Constant for calculating Cd from Smith and Vogl (2008) - real(r8), parameter :: Cd1=0.000065_r8 ! Constant for calculating Cd from Smith and Vogl (2008) - real(r8), parameter :: Cm=0.002_r8 ! Constant for calculating Cd from Smith and Vogl (2008) - real(r8), parameter :: v20=20.0_r8 ! Threshold wind speed (m/s) for calculating Cd from Smith and Vogl (2008) - real(r8) :: C ! Surface exchange coefficient for sensible and latent heat, depends on simple_physics_option - real(r8), parameter :: pbltop=85000._r8 ! Pressure (Pa) at the top of boundary layer - real(r8), parameter :: pblconst=10000._r8 ! Constant (Pa) for the calculation of the decay of diffusivity - - ! Variables for the simple-physics and moist HS boundary layer turbulence calculation - real(r8) :: wind(ncol) ! wind speed at the lowest model level (m/s) - real(r8) :: rho(ncol) ! Air density near the ground (kg/m3) - real(r8) :: Cd(ncol) ! Drag coefficient for momentum - real(r8) :: za(ncol) ! Height at midpoint of the lowest model level (m) - real(r8) :: dlnpint ! Used for calculation of heights - - ! Variables for the simple-physics and moist HS boundary layer turbulence calculation (for T and qv) - real(r8) :: CA(ncol,pver) ! Matrix Coefficents for PBL Scheme - real(r8) :: CC(ncol,pver) ! Matrix Coefficents for PBL Scheme - real(r8) :: CE(ncol,pver+1) ! Matrix Coefficents for PBL Scheme - real(r8) :: CFt(ncol,pver+1) ! Matrix Coefficents for PBL Scheme - real(r8) :: CFq(ncol,pver+1) ! Matrix Coefficents for PBL Scheme - - ! Variables for the simple-physics boundary layer turbulence calculation for u and v, not used by JT16, only by RJ12 - real(r8) :: CAm(ncol,pver) ! Matrix Coefficents for PBL Scheme - real(r8) :: CCm(ncol,pver) ! Matrix Coefficents for PBL Scheme - real(r8) :: CEm(ncol,pver+1) ! Matrix Coefficents for PBL Scheme - real(r8) :: CFu(ncol,pver+1) ! Matrix Coefficents for PBL Scheme - real(r8) :: CFv(ncol,pver+1) ! Matrix Coefficents for PBL Scheme - - ! Variable for surface flux calculation - real(r8) :: qsat ! saturation value for Q (kg/kg) - - ! Temporary storage variable - real(r8) :: tmp - - ! Loop variables - integer :: i, k - - ! Define simple_physics_option to either "TJ16" (moist HS) or "RJ12" (simple-physics) - character(LEN=4) :: simple_physics_option - - ! Set the simple_physics_option "TJ16" (default, moist HS) - simple_physics_option = "TJ16" - ! simple_physics_option = "RJ12" ! alternative simple-physics forcing, Reed and Jablonowski (2012) - - !========================================================================== - ! Calculate Sea Surface Temperature and set exchange coefficient - !========================================================================== - if (simple_physics_option == "TJ16") then - C=0.0044_r8 ! Surface exchange coefficient for sensible and latent heat for moist HS - do i = 1, ncol ! set SST profile - Tsurf(i) = del_T*exp(-(((clat(i))**2.0_r8)/(2.0_r8*(T_width**2.0_r8)))) + T_min - end do - else ! settings for RJ12 - C = 0.0011_r8 ! Surface exchange coefficient for sensible and latent heat for simple-physics - Tsurf = Tsurf_RJ12 ! constant SST - endif - - !========================================================================== - ! Pre-calculate trig functions - !========================================================================== - do i = 1, ncol - coslat (i) = cos(clat(i)) - sinsq (i) = sin(clat(i))*sin(clat(i)) - cossq (i) = coslat(i)*coslat(i) - cossqsq(i) = cossq (i)*cossq (i) - end do - - !========================================================================== - ! Initialize accumulated tendencies due to Eddy diffusion - !========================================================================== - dqdt_vdiff = 0.0_r8 - dtdt_vdiff = 0.0_r8 - - !========================================================================== - ! Calculate hydrostatic height za of the lowermost model level - !========================================================================== - do i = 1, ncol - dlnpint = (lnpint(i,2) - lnpint(i,1)) - za(i) = rair/gravit*T(i,pver)*(1._r8+zvir*qv(i,pver))*0.5_r8*dlnpint - end do - - !========================================================================== - ! Simple-physics surface fluxes and turbulence scheme for heat and moisture - ! - ! The PBL parameterization is based on a simplified Ekman - ! theory (constant Ke below 850 hPa). Ke is updated at each time step - ! and is linked to surface conditions. First, T and Q are updated with the - ! surface flux at the lowermost model level and then the semi-implicit - ! PBL scheme is applied. - ! - ! Details of the surface flux and PBL implementation can be found in: - ! Thatcher and Jablonowski (GMD, 2016) and Reed and Jablonowski (JAMES, 2012). - ! - ! Note that the exchange coefficient C is set to a different constant - ! in TJ16 and RJ12. - !========================================================================== - - !-------------------------------------------------------------------------- - ! Compute magnitude of the low-level wind, and diffusion coeffients (Ke and Km) - ! for PBL turbulence scheme (Eddy diffusivity), - ! Ke is used for heat and moisture (used by TJ16 and RJ12) - ! Km is used for momentum (not used by TJ16, only RJ12) - !-------------------------------------------------------------------------- - do i = 1, ncol - wind(i) = sqrt(U(i,pver)**2 + V(i,pver)**2) ! wind speed closest to the surface - end do - do i = 1, ncol - Ke(i,pver+1) = C*wind(i)*za(i) - if (wind(i) < v20) then ! if wind speed is less than 20 m/s - Cd(i) = Cd0+Cd1*wind(i) - Km(i,pver+1) = Cd(i)*wind(i)*za(i) - else - Cd(i) = Cm - Km(i,pver+1) = Cm*wind(i)*za(i) - end if - end do - - do k = 1, pver - do i = 1, ncol - if( pint(i,k) >= pbltop) then - ! keep diffusion coefficients constant below pbltop - Km(i,k) = Km(i,pver+1) - Ke(i,k) = Ke(i,pver+1) - else - ! PBL diffusion coefficients are dragged to zero above pbltop - Km(i,k) = Km(i,pver+1)*exp(-(pbltop-pint(i,k))**2/(pblconst)**2) - Ke(i,k) = Ke(i,pver+1)*exp(-(pbltop-pint(i,k))**2/(pblconst)**2) - end if - end do - end do - - !-------------------------------------------------------------------------- - ! Compute sensible and latent heat surface fluxes using an implicit approach - ! and update the variables T and qv - ! note: this only occurs in the lowermost model level - !-------------------------------------------------------------------------- - do i = 1, ncol - qsat = epsilo*e0/PS(i)*exp(-latvap/rh2o*((1._r8/Tsurf(i))-1._r8/T0)) ! saturation value for Q at the surface - rho(i) = pmid(i,pver)/(rair * T(i,pver) *(1._r8+zvir*qv(i,pver))) ! air density at the lowest level rho = p/(Rd Tv) - - tmp = (T(i,pver)+C*wind(i)*Tsurf(i)*dtime/za(i))/(1._r8+C*wind(i)*dtime/za(i)) ! new T - dtdt_vdiff(i,pver) = (tmp-T(i,pver))/dtime ! T tendency due to surface flux - shflx(i) = rho(i) * cpair * C*wind(i)*(Tsurf(i)-T(i,pver)) ! sensible heat flux (W/m2) - T(i,pver) = tmp ! update T - - tmp = (qv(i,pver)+C*wind(i)*qsat*dtime/za(i))/(1._r8+C*wind(i)*dtime/za(i)) ! new Q - dqdt_vdiff(i,pver) = (tmp-qv(i,pver))/dtime ! Q tendency due to surface flux - lhflx(i) = rho(i) * latvap * C*wind(i)*(qsat-qv(i,pver)) ! latent heat flux (W/m2) - evap(i) = rho(i) * C*wind(i)*(qsat-qv(i,pver)) ! surface water flux (kg/m2/s) - qv(i,pver) = tmp ! update Q - end do - - if (simple_physics_option == "RJ12") then - !-------------------------------------------------------------------------- - ! If the configuration is set to the simple-physics package by RJ12 compute - ! surface momentum fluxes using an implicit approach and update the variables u and v - ! note: this only occurs in the lowermost model level and the density field rho from - ! above is used - !-------------------------------------------------------------------------- - do i = 1, ncol - tmp = Cd(i) * wind(i) - taux(i) = -rho(i) * tmp * U(i,pver) ! zonal surface momentum flux (N/m2) - U(i,pver) = U(i,pver)/(1._r8+tmp*dtime/za(i)) ! new U - tauy(i) = -rho(i) * tmp * V(i,pver) ! meridional surface momentum flux (N/m2) - V(i,pver) = V(i,pver)/(1._r8+tmp*dtime/za(i)) ! new V - enddo - endif - - !-------------------------------------------------------------------------- - ! Calculate Diagonal Variables for PBL Scheme (semi-implicit technique follows the CESM PBL implementation) - !-------------------------------------------------------------------------- - do k = 1, pver-1 - do i = 1, ncol - rho(i) = (pint(i,k+1)/(rair*(T(i,k+1)*(1._r8+zvir*qv(i,k+1))+T(i,k)*(1._r8+zvir*qv(i,k)))/2.0_r8)) - CA(i,k) = rpdel(i,k)*dtime*gravit*gravit*Ke(i,k+1)*rho(i)*rho(i)/(pmid(i,k+1)-pmid(i,k)) - CC(i,k+1) = rpdel(i,k+1)*dtime*gravit*gravit*Ke(i,k+1)*rho(i)*rho(i)/(pmid(i,k+1)-pmid(i,k)) - ! the next two PBL variables are initialized here for the potential use of RJ12 instead of TJ16 - ! since they need to use the same density field rho - CAm(i,k) = rpdel(i,k)*dtime*gravit*gravit*Km(i,k+1)*rho(i)*rho(i)/(pmid(i,k+1)-pmid(i,k)) - CCm(i,k+1) = rpdel(i,k+1)*dtime*gravit*gravit*Km(i,k+1)*rho(i)*rho(i)/(pmid(i,k+1)-pmid(i,k)) - end do - end do - do i = 1, ncol - CA(i,pver) = 0._r8 - CC(i,1) = 0._r8 - CE(i,pver+1) = 0._r8 - CFt(i,pver+1) = 0._r8 - CFq(i,pver+1) = 0._r8 - end do - do i = 1, ncol - do k = pver, 1, -1 - CE(i,k) = CC(i,k)/(1._r8+CA(i,k)+CC(i,k)-CA(i,k)*CE(i,k+1)) - CFt(i,k) = ((ps0/pmid(i,k))**cappa*T(i,k)+CA(i,k)*CFt(i,k+1))/(1._r8+CA(i,k)+CC(i,k)-CA(i,k)*CE(i,k+1)) - CFq(i,k) = (qv(i,k)+CA(i,k)*CFq(i,k+1))/(1._r8+CA(i,k)+CC(i,k)-CA(i,k)*CE(i,k+1)) - end do - end do - - !-------------------------------------------------------------------------- - ! Calculate the updated temperature T and moisture Q fields - !-------------------------------------------------------------------------- - - !--------------------------------------------------------------------- - ! First: calculate the PBL mixing tendencies at the top model level - !--------------------------------------------------------------------- - do i = 1, ncol - tmp = CFt(i,1)*(pmid(i,1)/ps0)**cappa ! new T at the model top - dtdt_vdiff(i,1) = (tmp-T(i,1))/dtime ! T tendency due to PBL diffusion (model top) - T(i,1) = tmp ! update T at the model top - - dqdt_vdiff(i,1) = (CFq(i,1)-qv(i,1))/dtime ! Q tendency due to PBL diffusion (model top) - qv(i,1) = CFq(i,1) ! update Q at the model top - end do - - !----------------------------------------- - ! PBL mixing at all other model levels - !----------------------------------------- - do i = 1, ncol - do k = 2, pver - tmp = (CE(i,k)*T(i,k-1)*(ps0/pmid(i,k-1))**cappa+CFt(i,k))*(pmid(i,k)/ps0)**cappa ! new T - dtdt_vdiff(i,k) = dtdt_vdiff(i,k) + (tmp-T(i,k))/dtime ! update the T tendency due to surface fluxes and the PBL diffusion - T(i,k) = tmp ! update T - - tmp = CE(i,k)*qv(i,k-1)+CFq(i,k) ! new Q - dqdt_vdiff(i,k) = dqdt_vdiff(i,k) + (tmp-qv(i,k))/dtime ! update the Q tendency due to surface fluxes and the PBL diffusion - qv(i,k) = tmp ! update Q - end do - end do - - if (simple_physics_option == "TJ16") then - !========================================================================== - ! modified HS forcing (see Thatcher and Jablonowski (GMD, 2016)) - !-------------------------------------------------------------------------- - ! The original Held-Suarez (HS) physics algorithm is described in - ! - ! Held, I. M., and M. J. Suarez, 1994: A proposal for the - ! intercomparison of the dynamical cores of atmospheric general - ! circulation models. - ! Bulletin of the Amer. Meteor. Soc., vol. 75, pp. 1825-1830 - ! - ! The modified version uses the redefined parameters: trefc, delta_T - !========================================================================== - - !-------------------------------------------------------------------------- - ! Compute frictional tendency from HS Rayleigh Friction (RF) at the lowest - ! level as a diagnostic (surface momentum fluxes) - !-------------------------------------------------------------------------- - kv = kf*(etamid(pver) - sigmab)/onemsig ! RF coefficient at the lowest level - do i = 1, ncol - dlnpint = (lnpint(i,2) - lnpint(i,1)) - za(i) = rair/gravit*T(i,pver)*(1._r8+zvir*qv(i,pver))*0.5_r8*dlnpint ! height of lowest full model level - rho(i) = pmid(i,pver)/(rair * T(i,pver) *(1._r8+zvir*qv(i,pver))) ! air density at the lowest level rho = p/(Rd Tv) - taux(i) = -kv * rho(i) * U(i,pver) * za(i) ! U surface momentum flux in N/m2 - tauy(i) = -kv * rho(i) * V(i,pver) * za(i) ! V surface momentum flux in N/m2 - end do - - !-------------------------------------------------------------------------- - ! Apply HS Rayleigh Friction (RF) near the surface (below eta=0.7): - ! represents surface stresses and PBL diffusion for U and V - !-------------------------------------------------------------------------- - do k = 1, pver - if (etamid(k) > sigmab) then - kv = kf*(etamid(k) - sigmab)/onemsig ! RF coefficient - do i=1,ncol - U(i,k) = U(i,k) -kv*U(i,k)*dtime ! apply RF to U - V(i,k) = V(i,k) -kv*V(i,k)*dtime ! apply RF to V - end do - end if - end do - - !----------------------------------------------------------------------- - ! Compute idealized radiative heating rates (with modified HS equilibrium temperature) - ! mimics radiation - !----------------------------------------------------------------------- - do k = 1, pver - if (etamid(k) > sigmab) then ! lower atmosphere - do i = 1, ncol - kt = ka + (ks - ka)*cossqsq(i)*(etamid(k) - sigmab)/onemsig ! relaxation coefficent varies in the vertical - trefc = T_max - delta_T*sinsq(i) - trefa = (trefc - delta_theta*cossq(i)*log((pmid(i,k)/ps0)))*(pmid(i,k)/ps0)**cappa - trefa = max(t00,trefa) ! relaxation temperature - dtdt_heating(i,k) = (trefa - T(i,k))*kt ! temperature forcing due to relaxation - T(i,k) = T(i,k) + dtdt_heating(i,k)*dtime ! update T - end do - else - do i=1,ncol - trefc = T_max - delta_T*sinsq(i) - trefa = (trefc - delta_theta*cossq(i)*log((pmid(i,k)/ps0)))*(pmid(i,k)/ps0)**cappa - trefa = max(t00,trefa) ! relaxation temperature - dtdt_heating(i,k) = (trefa - T(i,k))*ka ! temperature forcing due to relaxation - T(i,k) = T(i,k) + dtdt_heating(i,k)*dtime ! update T - end do - end if - end do - - else - !========================================================================== - ! RJ12: Surface flux and PBL forcing of u and v follows the Reed-Jablonowski simple-physics configuration - ! no HS temperature relaxation is used which limits this configuration to - ! short simulation periods (under 30 days) - !-------------------------------------------------------------------------- - - !-------------------------------------------------------------------------- - ! Calculate Diagonal Variables for PBL Scheme (semi-implicit technique follows the CESM PBL implementation) - ! The fields CAm and CCm are also initialized above to guarantee the use of the same density. - !-------------------------------------------------------------------------- - do i = 1, ncol - CAm(i,pver) = 0._r8 - CCm(i,1) = 0._r8 - CEm(i,pver+1) = 0._r8 - CFu(i,pver+1) = 0._r8 - CFv(i,pver+1) = 0._r8 - end do - do i = 1, ncol - do k = pver, 1, -1 - CEm(i,k) = CCm(i,k)/(1._r8+CAm(i,k)+CCm(i,k)-CAm(i,k)*CEm(i,k+1)) - CFu(i,k) = (U(i,k)+CAm(i,k)*CFu(i,k+1))/(1._r8+CAm(i,k)+CCm(i,k)-CAm(i,k)*CEm(i,k+1)) - CFv(i,k) = (V(i,k)+CAm(i,k)*CFv(i,k+1))/(1._r8+CAm(i,k)+CCm(i,k)-CAm(i,k)*CEm(i,k+1)) - end do - end do - - !-------------------------------------------------------------------------- - ! Calculate the updated velocity fields U and V - !-------------------------------------------------------------------------- - - !--------------------------------------------------------------------- - ! First: calculate the PBL diffusive tendencies at the top model level - !--------------------------------------------------------------------- - do i = 1, ncol - U(i,1) = CFu(i,1) ! new U at the model top - V(i,1) = CFv(i,1) ! new V at the model top - end do - - !----------------------------------------- - ! PBL diffusion of U and V at all other model levels - !----------------------------------------- - do i = 1, ncol - do k = 2, pver - U(i,k) = CEm(i,k)*U(i,k-1) + CFu(i,k) ! new U - V(i,k) = CEm(i,k)*V(i,k-1) + CFv(i,k) ! new V - end do - end do - endif - - end subroutine Thatcher_Jablonowski_sfc_pbl_hs - - !======================================================================= - -end module TJ2016 diff --git a/src/physics/simple/tj2016_cam.F90 b/src/physics/simple/tj2016_cam.F90 index 7d6e48adf1..59e5b6cd58 100644 --- a/src/physics/simple/tj2016_cam.F90 +++ b/src/physics/simple/tj2016_cam.F90 @@ -11,7 +11,7 @@ module TJ2016_cam !----------------------------------------------------------------------- use shr_kind_mod, only: r8 => shr_kind_r8 - use ppgrid, only: pcols, pver + use ppgrid, only: pcols, pver, pverp use constituents, only: pcnst use physics_buffer, only: dtype_r8, pbuf_add_field, physics_buffer_desc, & @@ -50,12 +50,9 @@ subroutine Thatcher_Jablonowski_init(pbuf2d) use cam_history, only: addfld, add_default use physconst, only: gravit, cappa, rair, cpair, latvap, rh2o, epsilo, rhoh2o, zvir use hycoef, only: ps0, etamid - use tj2016, only: Thatcher_Jablonowski_set_const type(physics_buffer_desc), pointer :: pbuf2d(:,:) - call Thatcher_Jablonowski_set_const(gravit, cappa, rair, cpair, latvap, rh2o, epsilo, rhoh2o, zvir, ps0, etamid) - ! This field is added by radiation when full physics is used call addfld('QRS', (/ 'lev' /), 'A', 'K/s', & 'Temperature tendency associated with the relaxation toward the equilibrium temperature profile') @@ -90,8 +87,10 @@ subroutine Thatcher_Jablonowski_precip_tend(state, ptend, ztodt, pbuf) !----------------------------------------------------------------------- use physics_types, only: physics_state, physics_ptend use physics_types, only: physics_ptend_init - use physconst, only: cpair - use TJ2016, only: Thatcher_Jablonowski_precip + use physconst, only: gravit, latvap, rh2o, epsilo, rhoh2o + use hycoef, only: ps0, etamid + use air_composition, only: cpairv, rairv + use TJ2016_precip, only: tj2016_precip_run ! arguments @@ -101,6 +100,9 @@ subroutine Thatcher_Jablonowski_precip_tend(state, ptend, ztodt, pbuf) type(physics_ptend), intent(out) :: ptend ! Package tendencies type(physics_buffer_desc), pointer :: pbuf(:) + character(len=512) :: scheme_name ! CCPP physics scheme name (not used in CAM) + character(len=512) :: errmsg + integer :: errflg ! local variables @@ -150,18 +152,17 @@ subroutine Thatcher_Jablonowski_precip_tend(state, ptend, ztodt, pbuf) ! Output arguments ! relhum: relative humidity (%) ! precl: large-scale precipitation rate (m/s) - ! precc: convective precipitation rate (m/s) (optional process) call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw) call pbuf_get_field(pbuf, relhum_idx, relhum) - call Thatcher_Jablonowski_precip(ncol, pver, ztodt, & - state%pmid(:ncol,:), state%pdel(:ncol,:), & - T, qv, relhum(:ncol,:), prec_pcw(:ncol), precc) + call tj2016_precip_run(ncol, pver, gravit, rairv(:ncol,:,lchnk), cpairv(:ncol,:,lchnk), & + latvap, rh2o, epsilo, rhoh2o, ps0, etamid, ztodt, state%pmid(:ncol,:), & + state%pdel(:ncol,:), T, qv, relhum(:ncol,:), prec_pcw(:ncol), ptend%s(:ncol,:), & + scheme_name, errmsg, errflg) - ! Back out temperature and specific humidity tendencies from updated fields + ! Back out specific humidity tendencies from updated fields do k = 1, pver - ptend%s(:ncol,k) = (T(:, k) - state%T(:ncol, k)) / ztodt * cpair ptend%q(:ncol,k,1) = (qv(:, k) - state%q(:ncol, k, 1)) / ztodt end do @@ -177,9 +178,11 @@ subroutine Thatcher_Jablonowski_sfc_pbl_hs_tend(state, ptend, ztodt, cam_in) !----------------------------------------------------------------------- use physics_types, only: physics_state, physics_ptend use physics_types, only: physics_ptend_init - use physconst, only: cpair + use physconst, only: gravit, latvap, rh2o, epsilo, rhoh2o, pi + use hycoef, only: ps0, etamid use phys_grid, only: get_rlat_all_p - use TJ2016, only: Thatcher_Jablonowski_sfc_pbl_hs + use TJ2016_sfc_pbl_hs, only: tj2016_sfc_pbl_hs_run + use air_composition, only: cpairv, rairv, cappav ! Arguments type(physics_state), intent(in) :: state @@ -193,8 +196,8 @@ subroutine Thatcher_Jablonowski_sfc_pbl_hs_tend(state, ptend, ztodt, cam_in) integer :: lchnk ! chunk identifier integer :: ncol ! number of atmospheric columns + real(r8) :: zvirv(pcols,pver) ! ratio of water vapor to dry air constants - 1 real(r8) :: clat(state%ncol) ! latitudes(radians) for columns - real(r8) :: lnpint(state%ncol, 2) ! ln(int. press. (Pa)) real(r8) :: T(state%ncol, pver) ! T temporary real(r8) :: qv(state%ncol, pver) ! Q temporary (specific humidity) real(r8) :: U(state%ncol, pver) ! U temporary @@ -207,6 +210,10 @@ subroutine Thatcher_Jablonowski_sfc_pbl_hs_tend(state, ptend, ztodt, cam_in) real(r8) :: dtdt_heating(state%ncol,pver) ! temperature tendency from relaxation in K/s real(r8) :: Km(state%ncol,pver+1) ! Eddy diffusivity at layer interfaces for boundary layer calculations (m2/s) real(r8) :: Ke(state%ncol,pver+1) ! Eddy diffusivity at layer interfaces for boundary layer calculations (m2/s) + + character(len=512) :: scheme_name ! CCPP physics scheme name (not used in CAM) + character(len=512) :: errmsg + integer :: errflg !----------------------------------------------------------------------- lchnk = state%lchnk @@ -214,12 +221,15 @@ subroutine Thatcher_Jablonowski_sfc_pbl_hs_tend(state, ptend, ztodt, cam_in) call get_rlat_all_p(lchnk, ncol, clat) ! Gather temporary arrays - lnpint(:ncol, 1:2) = state%lnpint(:ncol,pver:pver+1) T(:ncol, :) = state%T(:ncol, :) U(:ncol, :) = state%U(:ncol, :) V(:ncol, :) = state%V(:ncol, :) qv(:ncol, :) = state%Q(:ncol, :, 1) + do k = 1, pver + zvirv(:ncol,k) = rh2o/rairv(:ncol,k, lchnk) - 1._r8 + end do + ! initialize individual parameterization tendencies lq = .false. lq(1) = .true. @@ -258,17 +268,16 @@ subroutine Thatcher_Jablonowski_sfc_pbl_hs_tend(state, ptend, ztodt, cam_in) ! Ke: Eddy diffusivity for boundary layer calculations ! cam_in%sst: Sea surface temperature K (varied by latitude) - call Thatcher_Jablonowski_sfc_pbl_hs(ncol, pver, ztodt, clat, & - state%ps(:ncol), state%pmid(:ncol,:), state%pint(:ncol,:), lnpint, & - state%rpdel(:ncol,:), T, U, V, qv, cam_in%shf(:ncol), cam_in%lhf(:ncol), & - cam_in%wsx(:ncol), cam_in%wsy(:ncol), cam_in%cflx(:ncol,1), dqdt_vdiff, & - dtdt_vdiff, dtdt_heating, Km, Ke, cam_in%sst(:ncol)) + call tj2016_sfc_pbl_hs_run(ncol, pver, pverp, 1, pver, pverp, gravit, pi, & + cappav(:ncol,:, lchnk), rairv(:ncol,:,lchnk), cpairv(:ncol,:,lchnk), latvap, rh2o, epsilo, & + rhoh2o, zvirv(:ncol,:), ps0, etamid, ztodt, clat, state%ps(:ncol), state%pmid(:ncol,:), & + state%pint(:ncol,:), state%lnpint(:ncol,:), state%rpdel(:ncol,:), T, & + U, ptend%u(:ncol,:), V, ptend%v(:ncol,:), qv, cam_in%shf(:ncol), cam_in%lhf(:ncol), cam_in%wsx(:ncol), & + cam_in%wsy(:ncol), cam_in%cflx(:ncol,1), dqdt_vdiff, dtdt_vdiff, dtdt_heating, Km, Ke, cam_in%sst(:ncol), & + ptend%s(:ncol,:), scheme_name, errmsg, errflg) ! Back out tendencies from updated fields do k = 1, pver - ptend%s(:ncol,k) = (T(:, k) - state%T(:ncol, k)) / ztodt * cpair - ptend%u(:ncol,k) = (U(:, k) - state%U(:ncol, k)) / ztodt - ptend%v(:ncol,k) = (V(:, k) - state%V(:ncol, k)) / ztodt ptend%q(:ncol,k,1) = (qv(:, k) - state%q(:ncol, k, 1)) / ztodt end do diff --git a/src/physics/waccm/efield.F90 b/src/physics/waccm/efield.F90 index 3ad30a970a..90508549b2 100644 --- a/src/physics/waccm/efield.F90 +++ b/src/physics/waccm/efield.F90 @@ -81,7 +81,7 @@ module efield integer, parameter :: & nmlon1f = nmlon/4, & ! 1 fourth mlon nmlon2f = nmlon/2, & ! 2 fourths mlon - nmlon3f = 3*nmlon/4 ! 3 fourths mlon + nmlon3f = 3*nmlon/4 ! 3 fourths mlon real(r8) :: & ylatm(0:nmlat), & ! magnetic latitudes (deg) @@ -1194,7 +1194,7 @@ subroutine bnd_sinus( ihlat_bnd, itrans_width ) ! Author: A. Maute Nov 2003 am 11/20/03 !---------------------------------------------------------------------------- - use sv_decomp, only : svdcmp, svbksb + external DGESV ! LAPACK routine to solve matrix eq !---------------------------------------------------------------------------- ! ... dummy arguments @@ -1216,6 +1216,11 @@ subroutine bnd_sinus( ihlat_bnd, itrans_width ) real(r8) :: w(nmax_a,nmax_a) real(r8) :: f(-nmax_sin:nmax_sin,0:nmlon) + real(r8) :: x(nmax_a) + integer :: ipiv(nmax_a), info + + character(len=120) :: msg + !---------------------------------------------------------------------------- ! Sinusoidal Boundary calculation !---------------------------------------------------------------------------- @@ -1224,6 +1229,7 @@ subroutine bnd_sinus( ihlat_bnd, itrans_width ) u(:,:) = 0._r8 v(:,:) = 0._r8 w(:,:) = 0._r8 + ipiv(:) = 0 do ilon = 0,nmlon ! long. bnd = nmlath - ihlat_bnd(ilon) ! switch from pole=0 to pole =90 @@ -1238,19 +1244,18 @@ subroutine bnd_sinus( ihlat_bnd, itrans_width ) end do end do end do - -! if (debug) write(iulog,*) ' Single Value Decomposition' - call svdcmp( u, nmax_a, nmax_a, nmax_a, nmax_a, w, v ) - -! if (debug) write(iulog,*) ' Solving' - call svbksb( u, w, v, nmax_a, nmax_a, nmax_a, nmax_a, rhs, lsg ) +! + x(:) = rhs(:) + call DGESV( nmax_a, 1, u, nmax_a, ipiv, x, nmax_a, info) + if (info/=0) then + write(msg,'(a,i4)') 'bnd_sinus -- LAPACK DGESV return error code: ',info + if (masterproc) write(iulog,*) trim(msg) + call endrun(trim(msg)) + end if + lsg(:) = x(:) ! do ilon = 0,nmlon ! long. -! sum = 0._r8 sum = dot_product( lsg(-nmax_sin+ishf:nmax_sin+ishf),f(-nmax_sin:nmax_sin,ilon) ) -! do i = -nmax_sin,nmax_sin -! sum = sum + lsg(i+ishf)*f(i,ilon) -! end do ihlat_bnd(ilon) = nmlath - int( sum + .5_r8 ) ! closest point itrans_width(ilon) = int( 8._r8 - 2._r8*cos( ylonm(ilon)*dtr ) + .5_r8 )/dlatm ! 6 to 10 deg. end do diff --git a/src/physics/waccmx/ion_electron_temp.F90 b/src/physics/waccmx/ion_electron_temp.F90 index e272b9aaa0..3e5718eaa4 100644 --- a/src/physics/waccmx/ion_electron_temp.F90 +++ b/src/physics/waccmx/ion_electron_temp.F90 @@ -34,6 +34,7 @@ module ion_electron_temp use spmd_utils, only : masterproc use cam_logfile, only : iulog ! Output unit use ionos_state_mod, only : ionos_state + use air_composition,only : cpairv implicit none @@ -135,16 +136,16 @@ subroutine ion_electron_temp_init(pbuf2d) !------------------------------------------------------------------------------- ! Add history variables for ionosphere !------------------------------------------------------------------------------- - call addfld ('QIonElec' ,(/ 'lev' /), 'I', 'K/s', 'Electron Ion Thermal Heating Rate') + call addfld ('QIonElec' ,(/ 'lev' /), 'I', 'K sec-1', 'Electron Ion Thermal Heating Rate') call addfld ('TElec&IC' ,(/ 'lev' /), 'I', 'K', 'Electron Temperature') call addfld ('TIon&IC' ,(/ 'lev' /), 'I', 'K', 'Ion Temperature') call addfld ('TElec' ,(/ 'lev' /), 'I', 'K', 'Electron Temperature') call addfld ('TIon' ,(/ 'lev' /), 'I', 'K', 'Ion Temperature') call addfld ('ElecColDens' ,horiz_only , 'I', 'TECU', 'Electron Column Density') if (.not.steady_state_ion_elec_temp) then - call addfld ('QIN' ,(/ 'lev' /), 'I', 'J/kg/s', 'Ion-neutral Heating') - call addfld ('QEN' ,(/ 'lev' /), 'I', ' ', 'Electron-neutral Heating') - call addfld ('QEI' ,(/ 'lev' /), 'I', ' ', 'Electron-ion Heating') + call addfld ('QIN' ,(/ 'lev' /), 'I', 'K sec-1','Ion-neutral Heating Rate') + call addfld ('QEN' ,(/ 'lev' /), 'I', 'K sec-1','Electron-neutral Heating Rate') + call addfld ('QEI' ,(/ 'lev' /), 'I', 'K sec-1','Electron-ion Heating Rate') call addfld ('LOSS_g3' ,(/ 'lev' /), 'I', ' ', 'Loss Term g3') call addfld ('LOSS_EI' ,(/ 'lev' /), 'I', ' ', 'Loss Term EI') call addfld ('LOSS_IN' ,(/ 'lev' /), 'I', ' ', 'Loss Term IN') @@ -334,7 +335,6 @@ end subroutine ion_electron_temp_inidat subroutine ion_electron_temp_tend(state, ptend, pbuf, ztodt) - use air_composition, only: cpairv !------------------------------------------------------------------------------------- ! Calculate dry static energy and O+ tendency for extended ionosphere simulation !------------------------------------------------------------------------------------- @@ -1037,9 +1037,9 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi real(r8), dimension(pcols,pver) :: delZ ! Delta z: midpoints real(r8), dimension(pcols,pver) :: qjoule ! joule heating - real(r8), dimension(pcols,pver) :: qen ! electron-neutral heating - real(r8), dimension(pcols,pver) :: qei ! electron-ion Coulomb heating - real(r8), dimension(pcols,pver) :: qin ! ion-neutral heating + real(r8), dimension(pcols,pver) :: qen ! electron-neutral heating (units: ev/g/s) + real(r8), dimension(pcols,pver) :: qei ! electron-ion Coulomb heating (units: ev/g/s) + real(r8), dimension(pcols,pver) :: qin ! ion-neutral heating (units: ev/g/s) real(r8), dimension(pcols,pver) :: rho ! mass density real(r8), dimension(pcols,pver) :: wrk2 @@ -1053,6 +1053,7 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi logical, dimension(pcols) :: colConv ! flag for column converging logical :: converged ! Flag for convergence in electron temperature ! calculation iteration loop + real(r8) :: qrate(pcols,pver) ! heating rate diagnostic !--------------------------------------------------------------------------------------------------------- ! Initialize arrays to zero and column convergence logical to .false. @@ -1452,9 +1453,14 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi dSETendOut(1:ncol,1:teTiBot) = (qei(1:ncol,1:teTiBot)+qen(1:ncol,1:teTiBot)) / sToQConv ! J/kg/s - call outfld ('QEN', qen, pcols, lchnk) - call outfld ('QEI', qei, pcols, lchnk) - call outfld ('QIN', qin, pcols, lchnk) + qrate(:ncol,:) = qen(:ncol,:)/sToQConv/cpairv(:ncol,:,lchnk) ! K/s + call outfld ('QEN', qrate, pcols, lchnk) + + qrate(:ncol,:) = qei(:ncol,:)/sToQConv/cpairv(:ncol,:,lchnk) ! K/s + call outfld ('QEI', qrate, pcols, lchnk) + + qrate(:ncol,:) = qin(:ncol,:)/sToQConv/cpairv(:ncol,:,lchnk) ! K/s + call outfld ('QIN', qrate, pcols, lchnk) return diff --git a/src/utils/hycoef.F90 b/src/utils/hycoef.F90 index 2abfbb2ec7..241abf5c7e 100644 --- a/src/utils/hycoef.F90 +++ b/src/utils/hycoef.F90 @@ -21,6 +21,10 @@ module hycoef ! interfaces p(k) = hyai(k)*ps0 + hybi(k)*ps ! midpoints p(k) = hyam(k)*ps0 + hybm(k)*ps ! +! Note: Module data with a target attribute are targets of pointers in hist_coord_t +! objects in the cam_history_support module. They are associated by the calls +! to add_hist_coord and add_vert_coord +! !----------------------------------------------------------------------- real(r8), public, target :: hyai(plevp) ! ps0 component of hybrid coordinate - interfaces @@ -41,7 +45,7 @@ module hycoef real(r8), public, protected :: ps0 = 1.0e5_r8 ! Base state surface pressure (pascals) real(r8), public, protected :: psr = 1.0e5_r8 ! Reference surface pressure (pascals) #endif -real(r8), target :: alev(plev) ! level values (pascals) for 'lev' coord +real(r8), target :: alev(plev) ! level values (hPa) for 'lev' coord real(r8), target :: ailev(plevp) ! interface level values for 'ilev' coord integer, public :: nprlev ! number of pure pressure levels at top diff --git a/test/system/TGIT.sh b/test/system/TGIT.sh index db04179217..e6d6557030 100755 --- a/test/system/TGIT.sh +++ b/test/system/TGIT.sh @@ -1,6 +1,6 @@ #!/bin/sh # Test for bad git repo -# Ensures that the top-level CAM directory +# Ensures that the top-level CAM directory # has ".git" directory and ".gitignore" file, # and no other git files or directories. @@ -9,7 +9,7 @@ # 2: Missing ".git" directory # 3: Missing ".gitignore" file # 4: Missing ".github" directory -# 5: More than three ".git*" files or directories +# 5: Missing ".gitmodules" file # 6: Error from running an external command # Utility to check return code. @@ -66,7 +66,7 @@ The ".gitignore" file is missing from the CAM git repo. Was this repo cloned, c modified incorrectly? If so then copy the .gitignore file from a standard CAM git repo. EOF rc=3 - fi + fi # Check for ".github" directory: if [ ! -d "${cam_top_dir}/.github" ]; then @@ -77,15 +77,11 @@ EOF rc=4 fi - # Check if there are more ".git*" files or directories than just ".git", ".gitignore", - # and ".github": - git_file_num=$(find "${cam_top_dir}" -maxdepth 1 -name '.git*' | wc -l) - - check_code "$?" "Problem running 'find' command for multi-git file check." - - if [ "${git_file_num}" -gt 3 ]; then + # Check for ".github" directory: + if [ ! -f "${cam_top_dir}/.gitmodules" ]; then cat <> foreach temp ( /fs/cgd/csm/inputdata/atm/cam2/gtopo30data/* ) -foreach? ln -s $temp -foreach? end - -Once the appropriate data files are in place, simply type: -./definehires - -This will produce a new 10-minute high-resolution dataset named -topo_gtopo30_10min.nc - - - -------------------------------------- -Feb 01, 2005 -------------------------------------- - -------------------------------------- -*********** definehires ************* -------------------------------------- - -The GTOPO30 30" is converted to a 10' dataset using definehires - Originally by Jiundar Chern (jchern@dao.gsfc.nasa.gov), - updated by Jim McCaa (jmccaa@ucar.edu) - updated by B.A. Boville - -./definehires generates file "topo_gtopo30_10min.nc" containing 5 variables - lon dimension variable of longitudes - lat dimension variable of latitudes - variance variance of 30" height w.r.t. 10' grid - htopo average terrain height on 10' grid - landfract land fraction on 10' grid, - cells are either land or ocean on 30" grid - Caspian sea is identified as ocean, but has nonzero height - -The original GTOPO30 files contain only elevation, with a flag for -ocean points (NODATA=-9999). The Caspian Sea is not connected to the -oceans and is not at sea level. Definehires identifies the Caspian Sea -in the 30" data using an algorithm based on elevation. Therefore, -the land fraction reflects the presence of the Caspian and the -elevation is nonzero. - -method: - - Subroutine expand_sea is called 3 times, once for each GTOPO30 tile - which contains part of the Caspian. The arguments include the x,y - indices of a start point which is known to be in the Caspian. These - 3 points had to identified by hand. - - 1. the start point is flagged by - adding NODATA + NODATA to the original height - setting a flag true for the block of surrounding points: - (startx-1:startx+1,starty-1:starty+1) - - 2. find points with the same elevation as the start point and whose - flag is true. Flag them the same way as the start point. - - This provides an expanding mask of potential Caspian points, which - are flagged true, and an expanding region of actual Caspian points - which are flagged with the original elavation + NODATA + NODATA. - - Subroutine avg is called to compute the area weighted average and - land fraction of the 30" data with respect to the 10' grid. The - weighting accounts for the area change with latitude. Points with - elavation = NODATA are given elevation = 0 and land fraction = - 0. Caspian points (elevation < NODATA) are given their original - elevation (elevation - NODATA - NODATA) and land fraction = 0. - - The variance of the 30" height data with respect to the 10' average - is computed without area weighting. - -Note on method. The Caspian terrain height flag is exact because the -height is an integer. However, I would have preferred to - - Convert the height of ocean points from NODATA to ZERO and make a - land fraction array with 0. or 1.. This could be done with a - subroutine find_ocn. - - Then the Caspian points would retain their original elevations and - also get land fraction 0 in find_caspian (instead of - expand_sea). Still called for only the 3 tiles. - - Subroutine avg would not have to recognize anything special about - Caspian points. - - diff --git a/tools/definehires/gtopo30_to_10min.F90 b/tools/definehires/gtopo30_to_10min.F90 deleted file mode 100644 index 50ccae5c2e..0000000000 --- a/tools/definehires/gtopo30_to_10min.F90 +++ /dev/null @@ -1,721 +0,0 @@ -! -! DATE CODED: Oct 17, 2000 -! DESCRIPTION: This program reads USGS 30-sec terrain dataset in 33 tiles and converts -! them to 10-min resolution global dataset in one single NetCDF file. -! -! Author: Jiundar Chern (jchern@dao.gsfc.nasa.gov) -! -! ** Modified November, 2003 *** -! This code has been modified by Jim McCaa (jmccaa@ucar.edu) for use at NCAR. -! In particular: -! 1) Paths and compiler options have been changed. -! 2) The code now generates a Caspian Sea based on elevation, and reports these points -! as ocean. This is done through three calls to the new routine expand_sea. -! -! ** Modified February 4, 2005 B.A. Boville *** -! -! ROUTINES CALLED: -! netcdf routines -! -! COMPILING: -! -! NCAR SGI (chinookfe) f90 -I/usr/local/include -O -64 -mips4 -bytereclen -s -! -o gtopo30_to_10min gtopo30_to_10min.F90 -L/usr/local/lib64/r4i4 -lnetcdf -r8 - -! NASA DAO SGI: f90 -I/ford1/local/IRIX64/netcdf/include -O -64 -mips4 -bytereclen -s -! -o gtopo30_to_10min gtopo30_to_10min.F90 -L/ford1/local/IRIX64/netcdf/lib -lnetcdf -r8 - - program convterr - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This program converts USGS 30-sec terrain data set to 10-min resolution -! terrain data set. -! - implicit none -! - integer, parameter :: ntile = 33 ! number of tiles in USGS GTOPO30 dataset - integer, parameter :: im10 = 2160 ! total grids in x direction of 10-min global dataset - integer, parameter :: jm10 = 1080 ! total grids in y direction of 10-min global dataset - real(r8), parameter :: dx30s = 1.0/120.0 ! space interval for 30-sec data (in degree) - real(r8), parameter :: dx10m = 1.0/6.0 ! space interval for 10-min data (in degree) - - character (len=7) :: nmtile(ntile) ! name of each tile - integer :: ncols,nrows ! number of columns and rows for 30-sec tile - integer :: nodata ! integer for ocean point - integer :: ncol10,nrow10 ! number of columns and rows for 10-min tile - real(r8):: ulxmap ! longitude at the center of the upper-left corner cell in the 30-sec tile - real(r8):: ulymap ! latitude at the center of the upper-left corner cell in the 30-sec tile - real(r8):: lon1_10m ! longitude at the center of grid (1,1) in the 10-min global data - real(r8):: lat1_10m ! latitude at the center of grid (1,1) in the 10-min global data - real(r8):: lonsw10 ! longitude at the center of southwest corner cell in the 10-min tile - real(r8):: latsw10 ! latitude at the center of southwest corner cell in the 10-min tile - integer :: i1,j1 ! the (i,j) point of the southwest corner of the 10-min tile in the global grid - real(r8), dimension(im10,jm10) :: terr ! global 10-min terrain data - real(r8), dimension(im10,jm10) :: variance ! global 10-min variance of elevation - real(r8), dimension(im10,jm10) :: land_fraction !global 10-min land fraction - - integer :: alloc_error,dealloc_error - integer :: i,j,n ! index - integer*2, allocatable, dimension(:,:) :: iterr ! terrain data for 30-sec tile - real(r8), allocatable, dimension(:,:) :: terr10m ! terrain data for 10-min tile - real(r8), allocatable, dimension(:,:) :: psea10m ! percentage of ocaen for 10-min tile - real(r8), allocatable, dimension(:,:) :: var10m ! variance of 30-sec elevations for 10-min tile -! - lat1_10m=-90.0 + 0.5 * dx10m - lon1_10m=0.5*dx10m -! -! Initialize each tile name -! - nmtile(1) = 'W180N90' - nmtile(2) = 'W140N90' - nmtile(3) = 'W100N90' - nmtile(4) = 'W060N90' - nmtile(5) = 'W020N90' - nmtile(6) = 'E020N90' - nmtile(7) = 'E060N90' - nmtile(8) = 'E100N90' - nmtile(9) = 'E140N90' - - nmtile(10) = 'W180N40' - nmtile(11) = 'W140N40' - nmtile(12) = 'W100N40' - nmtile(13) = 'W060N40' - nmtile(14) = 'W020N40' - nmtile(15) = 'E020N40' - nmtile(16) = 'E060N40' - nmtile(17) = 'E100N40' - nmtile(18) = 'E140N40' - - nmtile(19) = 'W180S10' - nmtile(20) = 'W140S10' - nmtile(21) = 'W100S10' - nmtile(22) = 'W060S10' - nmtile(23) = 'W020S10' - nmtile(24) = 'E020S10' - nmtile(25) = 'E060S10' - nmtile(26) = 'E100S10' - nmtile(27) = 'E140S10' - - nmtile(28) = 'W180S60' - nmtile(29) = 'W120S60' - nmtile(30) = 'W060S60' - nmtile(31) = 'W000S60' - nmtile(32) = 'E060S60' - nmtile(33) = 'E120S60' - - do j = 1, jm10 - do i = 1, im10 - terr(i,j) = -9999.0 - variance(i,j) = -9999.0 - land_fraction(i,j) = -9999.0 - end do - end do - - do n = 1,ntile -! -! Read header for each tile -! - call rdheader(nmtile(n),nrows,ncols,nodata,ulxmap,ulymap) - -! -! Allocate space for array iterr -! - allocate ( iterr(ncols,nrows),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for iterr' - stop - end if -! -! Read terr data for each tile -! - call rdterr(nmtile(n),nrows,ncols,iterr) -! -! Allocate space for arrays terr10m and psea10m -! - nrow10 =nrows*dx30s/dx10m - ncol10 =ncols*dx30s/dx10m - allocate ( terr10m(ncol10,nrow10),psea10m(ncol10,nrow10),var10m(ncol10,nrow10),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for terr10m, psea10m, and var10m' - stop - end if -! -! Expand Caspian Sea for tiles 6 and 15 -! - if(nmtile(n).eq.'E020N90')call expand_sea(ncols,nrows,iterr,nodata,3600,5300) - if(nmtile(n).eq.'E020N90')call expand_sea(ncols,nrows,iterr,nodata,4088,5874) - if(nmtile(n).eq.'E020N40')call expand_sea(ncols,nrows,iterr,nodata,3600,1) -! -! area average of 30-sec tile to 10-min tile -! - call avg(ncols,nrows,iterr,nodata,ulymap,dx30s,ncol10,nrow10,terr10m,psea10m,var10m) - -! -! Print some info on the fields - print *, "min and max elevations: ", minval(terr10m), maxval(terr10m) - print *, "min and max variacnes: ", minval(var10m) , maxval(var10m) - print *, "min and max land frac: ", minval(psea10m), maxval(psea10m) -! -! fit the 10-min tile into global 10-min dataset -! Note: the 30-sec and 10-min tiles are scaned from north to south, the global 10-min dataset are -! scaned from south to north (90S to 90N) and east to west (0E to -0.1666667W) -! - latsw10 = nint(ulymap + 0.5 * dx30s) - nrow10 * dx10m + 0.5 * dx10m - lonsw10 = nint(ulxmap - 0.5 * dx30s) + 0.5 * dx10m - if( lonsw10 < 0.0 ) lonsw10=360.0+lonsw10 - i1 = nint( (lonsw10 - lon1_10m) / dx10m )+1 - if( i1 <= 0 ) i1 = i1 + im10 - if( i1 > im10 ) i1 = i1 - im10 - j1 = nint( (latsw10 - lat1_10m) / dx10m )+1 - -! print*,'ulymap,ulxmap,latsw10,lonsw10 = ',ulymap,ulxmap,latsw10,lonsw10 -! print*,'i1,j1 = ', i1,j1 - - call fitin(ncol10,nrow10,terr10m,psea10m,var10m,i1,j1,im10,jm10,terr,variance,land_fraction) -! -! Deallocate working space for arrays iterr, terr10m and psea10m -! - deallocate ( iterr,terr10m,psea10m,var10m,stat=dealloc_error ) - if( dealloc_error /= 0 ) then - print*,'Unexpected deallocation error for arrays iterr,terr10m,psea10m,var10m' - stop - end if - - end do - -! -! Print some info on the fields - print *, "min and max elevations: ", minval(terr), maxval(terr) - print *, "min and max variances: ", minval(variance), maxval(variance) - print *, "min and max land frac: ", minval(land_fraction), maxval(land_fraction) -! -! Write 10-min terrain dataset, variance and land_fraction to NetCDF file -! - call wrtncdf(im10,jm10,terr,variance, land_fraction,dx10m) - - end program convterr - - subroutine rdheader(nmtile,nrows,ncols,nodata,ulxmap,ulymap) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine read the header of USGA Global30 sec TOPO data set. -! - implicit none -! -! Dummy arguments -! - character (len=7), intent(in) :: nmtile ! name of the tile - integer, intent(out) :: nrows ! number of rows - integer, intent(out) :: ncols ! number of column - integer, intent(out) :: nodata ! integer for ocean data point - real(r8), intent(out) :: ulxmap - real(r8), intent(out) :: ulymap -! -! Local variables -! - character (len=11) :: flheader ! file name of the header - character (len=13) :: chars ! dummy character - - flheader=nmtile//'.HDR' - - print*,'flheader = ', flheader -! -! Open GTOPO30 Header File -! - open(unit=10,file=flheader,status='old',form='formatted') -! -! Read GTOPO30 Header file -! - read (10, *) - read (10, *) - read (10, *) chars,nrows - print*,chars,' = ',nrows - read (10, *) chars,ncols - print*,chars,' = ',ncols - read (10, *) - read (10, *) - read (10, *) - read (10, *) - read (10, *) - read (10, *) chars,nodata - print*,chars,' = ',nodata - read (10, *) chars,ulxmap - print*,chars,' = ',ulxmap - read (10, *) chars,ulymap - print*,chars,' = ',ulymap - close(10) - - end subroutine rdheader - - subroutine rdterr(nmtile,nrows,ncols,iterr) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine read the USGS Global 30-sec terrain data for each tile. -! - implicit none -! -! Dummy arguments -! - character (len=7), intent(in) :: nmtile ! name of the tile - integer, intent(in) :: nrows ! number of rows - integer, intent(in) :: ncols ! number of column - integer*2, dimension(ncols,nrows), intent(out) :: iterr ! terrain data -! -! Local variables -! - character (len=11) :: flterr ! file name for each terr dataset - integer :: io_error ! I/O status - integer :: i,j ! Index - integer :: length ! record length - - flterr=nmtile//'.DEM' - -! print*,'flterr = ', flterr -! print*,'nrows,ncols = ',nrows,ncols -! -! Open GTOPO30 Terrain dataset File -! - - length = 2 * ncols * nrows - io_error=0 - open(unit=11,file=flterr,access='direct',recl=length,iostat=io_error) - if( io_error /= 0 ) then - print*,'Open file error in subroutine rdterr' - print*,'iostat = ', io_error - stop - end if -! -! Read GTOPO30 Terrain data file -! - read (11,rec=1,iostat=io_error) ((iterr(i,j),i=1,ncols),j=1,nrows) -! - if( io_error /= 0 ) then - print*,'Data file error in subroutine rdterr' - print*,'iostat = ', io_error - stop - end if -! -! Print some info on the fields - print *, "min and max elevations: ", minval(iterr), maxval(iterr) -! -! Correct missing data in source files -! -! Missing data near dateline - - if( nmtile == 'W180S60' ) then - do j = 1, nrows - iterr(1,j) = iterr(2,j) - end do - else if (nmtile == 'E120S60') then - do j = 1, nrows - iterr(ncols-1,j) = iterr(ncols-2,j) - iterr(ncols,j) = iterr(ncols-2,j) - end do - end if -! -! Missing data at the southermost row near South pole -! - if( nmtile == 'E060S60' .or. nmtile == 'E120S60' .or. nmtile == 'W000S60' .or. & - nmtile == 'W060S60' .or. nmtile == 'W120S60' .or. nmtile == 'W180S60' ) then - do i=1,ncols - iterr(i,nrows) = iterr(i,nrows-1) - end do - end if -! -! print*,'iterr(1,1),iterr(ncols,nrows) = ', & -! iterr(1,1),iterr(ncols,nrows) - - close (11) - end subroutine rdterr - - subroutine avg(ncols,nrows,iterr,nodata,ulymap,dx30s,ncol10,nrow10,terr10m,psea10m,var10m) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine reduces the resolution of the terrain data from 30-sec to 10-min and -! compute the percentage of ocean cover (psea10m) -! - implicit none -! -! Dummy arguments -! - integer, intent(in) :: ncols ! number of column for 30-sec tile - integer, intent(in) :: nrows ! number of rows for 30-sec tile - integer*2, dimension(ncols,nrows), intent(inout) :: iterr ! terrain data for 30-sec tile - integer, intent(in) :: nodata ! integer for ocean data point - real(r8),intent(in) :: ulymap ! latitude at the center of the upper-left corner cell in the 30-sec tile - real(r8),intent(in) :: dx30s ! spacing interval for 30-sec data (in degree) - integer, intent(in) :: nrow10 ! number of rows for 10-min tile - integer, intent(in) :: ncol10 ! number of columns for 10-min tile - real(r8), dimension(ncol10,nrow10), intent(out) :: terr10m ! terrain data for 10-min tile - real(r8), dimension(ncol10,nrow10), intent(out) :: psea10m ! percentage ocean coverage for 10-min tile - real(r8), dimension(ncol10,nrow10), intent(out) :: var10m ! variance of 30-sec elevations -! -! Local variables -! - real(r8) :: lats,latn ! latitudes (in rad) for ths south and north edges of each 30-sec cell - real(r8) :: wt ! area weighting of each 30-sec cell - real(r8) :: wt_tot ! total weighting of each 10-min cell - real(r8) :: sumterr ! summation of terrain height of each 10-min cell - real(r8) :: sumsea ! summation of sea coverage of each 10-min cell - real(r8) :: pi ! pi=3.1415 - real(r8) :: latul ! latitude of the upper-left coner of 30-sec tile - integer :: n1,itmp,i1,i2,j1,j2 ! temporary working spaces - integer :: i,j,ii,jj ! index - logical, dimension(ncols,nrows) :: oflag - - pi = 4.0 * atan(1.0) -! - n1 = ncols / ncol10 - print*,'ncols,ncol10,n1 = ',ncols,ncol10,n1 - - itmp = nint( ulymap + 0.5 * dx30s ) - latul = itmp - print*,'ulymap,latul = ', ulymap,latul - oflag = .false. - - do j = 1, nrow10 - j1 = (j-1) * n1 + 1 - j2 = j * n1 - do i = 1, ncol10 - i1 = (i-1) * n1 + 1 - i2 = i * n1 - wt_tot = 0.0 - sumterr = 0.0 - sumsea = 0.0 - - do jj = j1, j2 - latn = ( latul - (jj -1) * dx30s ) * pi / 180.0 - lats = ( latul - jj * dx30s ) * pi / 180.0 - wt = sin( latn ) - sin( lats ) - - do ii = i1, i2 - wt_tot=wt_tot+wt - if ( iterr(ii,jj) == nodata ) then - sumsea = sumsea + wt - oflag(ii,jj) = .true. - else - if ( iterr(ii,jj) .lt.nodata ) then - ! this can only happen in the expand_sea routine - sumsea = sumsea + wt - oflag(ii,jj) = .true. - iterr(ii,jj) = iterr(ii,jj) - nodata - nodata - endif - sumterr = sumterr + iterr(ii,jj) * wt - end if - end do - end do - - terr10m(i,j) = sumterr / wt_tot - psea10m(i,j) = sumsea / wt_tot - - end do - end do - - ! Now compute variance of 30-second points - - do j = 1, nrow10 - j1 = (j-1) * n1 + 1 - j2 = j * n1 - - do i = 1, ncol10 - i1 = (i-1) * n1 + 1 - i2 = i * n1 - - wt_tot = 0.0 - var10m(i,j) = 0.0 - wt = 1.0 - do jj = j1, j2 - do ii = i1, i2 - wt_tot = wt_tot + wt - if ( .not. oflag(ii,jj) ) then - var10m(i,j) = var10m(i,j) + wt * (iterr(ii,jj)-terr10m(i,j))**2 - end if - end do - end do - var10m(i,j) = var10m(i,j) / wt_tot - - end do - end do - - end subroutine avg - - subroutine expand_sea(ncols,nrows,iterr,nodata,startx,starty) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine reduces the resolution of the terrain data from 30-sec to 10-min and -! compute the percentage of ocean cover (psea10m) -! - implicit none -! -! Dummy arguments -! - integer, intent(in) :: ncols ! number of column for 30-sec tile - integer, intent(in) :: nrows ! number of rows for 30-sec tile - integer*2, dimension(ncols,nrows), intent(inout) :: iterr ! terrain data for 30-sec tile - integer, intent(in) :: nodata ! integer for ocean data point - integer, intent(in) :: startx, starty ! where to begin the sea -! -! Local variables -! - real(r8):: maxh - integer :: i,j,per,ii,jj ! index - logical, dimension(0:ncols+1,0:nrows+1) :: flag ! terrain data for 30-sec tile - logical :: found - - flag = .false. - - maxh = iterr(startx,starty) - - iterr(startx,starty) = iterr(startx,starty) + nodata + nodata - flag(startx-1:startx+1,starty-1:starty+1) = .true. - - per = 0 - print *, 'expanding sea at ',maxh,' m ' - -2112 per = per + 1 - found = .false. - do j = starty - per, starty + per, per*2 - do i = startx - per, startx + per - if(i.ge.1.and.i.le.ncols.and.j.ge.1.and.j.le.nrows)then - if( iterr(i,j).eq.maxh .and. flag(i,j) ) then - iterr(i,j) = iterr(i,j) + nodata + nodata - flag(i-1:i+1,j-1:j+1) = .true. - found = .true. - endif - endif - end do - end do - - do i = startx - per, startx + per, per*2 - do j = starty - per + 1, starty + per - 1 - if(i.ge.1.and.i.le.ncols.and.j.ge.1.and.j.le.nrows)then - if( iterr(i,j).eq.maxh .and. flag(i,j) ) then - iterr(i,j) = iterr(i,j) + nodata + nodata - flag(i-1:i+1,j-1:j+1) = .true. - found = .true. - endif - endif - end do - end do - if (found)goto 2112 - print *, 'done with expand_sea' - return - - end subroutine expand_sea - - subroutine fitin(ncol10,nrow10,terr10m,psea10m,var10m,i1,j1,im10,jm10,terr,variance,land_fraction) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine put 10-min tile into the global dataset -! - implicit none -! -! Dummy arguments -! - integer, intent(in) :: ncol10 ! number of columns for 10-min tile - integer, intent(in) :: nrow10 ! number of rows for 10-min tile - real(r8), dimension(ncol10,nrow10), intent(in) :: terr10m ! terrain data for 10-min tile - real(r8), dimension(ncol10,nrow10), intent(in) :: psea10m ! percentage ocean coverage for 10-min tile - real(r8), dimension(ncol10,nrow10), intent(in) :: var10m ! variance of 30-sec elev for 10-min tile - integer, intent(in) :: i1,j1 ! the (i,j) point of the southwest corner of the 10-min tile - ! in the global grid - integer, intent(in) :: im10,jm10 ! the dimensions of the 10-min global dataset - real(r8),dimension(im10,jm10), intent(out) :: terr ! global 10-min terrain data - real(r8),dimension(im10,jm10), intent(out) :: variance ! global 10-min variance of elev - real(r8),dimension(im10,jm10), intent(out) :: land_fraction ! global 10-min land fraction -! -! Local variables -! - integer :: i,j,ii,jj ! index - - do j = 1, nrow10 - jj = j1 + (nrow10 - j) - do i = 1, ncol10 - ii = i1 + (i-1) - if( ii > im10 ) ii = ii - im10 - terr(ii,jj) = terr10m(i,j) - land_fraction(ii,jj) = 1.0 - psea10m(i,j) - variance(ii,jj) = var10m(i,j) - if( i == 1 .and. j == 1 ) & - print*,'i,j,ii,jj = ',i,j,ii,jj - if( i == ncol10 .and. j == nrow10 ) & - print*,'i,j,ii,jj = ',i,j,ii,jj - end do - end do - end subroutine fitin - - subroutine wrtncdf(im10,jm10,terr,variance,land_fraction,dx10m) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine save 10-min terrain data, variance, land fraction to NetCDF file -! - implicit none - -# include - -! -! Dummy arguments -! - integer, intent(in) :: im10,jm10 ! the dimensions of the 10-min global dataset - real(r8),dimension(im10,jm10), intent(in) :: terr ! global 10-min terrain data - real(r8),dimension(im10,jm10), intent(in) :: variance ! global 10-min variance data - real(r8),dimension(im10,jm10), intent(in) :: land_fraction !global 10-min land fraction - real(r8), intent(in) :: dx10m -! -! Local variables -! - real(r8),dimension(im10) :: lonar ! longitude array - real(r8),dimension(im10) :: latar ! latitude array - character (len=32) :: fout ! NetCDF output file - integer :: foutid ! Output file id - integer :: lonid, lonvid - integer :: latid, latvid - integer :: varianceid - integer :: htopoid - integer :: landfid - integer, dimension(2) :: variancedim,htopodim,landfdim - integer :: status ! return value for error control of netcdf routin - integer :: i,j - character (len=8) :: datestring - -! -! Fill lat and lon arrays -! - do i = 1,im10 - lonar(i)= dx10m * (i-0.5) - enddo - do j = 1,jm10 - latar(j)= -90.0 + dx10m * (j-0.5) - enddo - - fout='topo_gtopo30_10min.nc' -! -! Create NetCDF file for output -! - status = nf_create (fout, NF_WRITE, foutid) - if (status .ne. NF_NOERR) call handle_err(status) -! -! Create dimensions for output -! - status = nf_def_dim (foutid, 'lon', im10, lonid) - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_def_dim (foutid, 'lat', jm10, latid) - if (status .ne. NF_NOERR) call handle_err(status) -! -! Create variable for output -! - variancedim(1)=lonid - variancedim(2)=latid - status = nf_def_var (foutid,'variance', NF_FLOAT, 2, variancedim, varianceid) - if (status .ne. NF_NOERR) call handle_err(status) - - htopodim(1)=lonid - htopodim(2)=latid - status = nf_def_var (foutid,'htopo', NF_FLOAT, 2, htopodim, htopoid) - if (status .ne. NF_NOERR) call handle_err(status) - - landfdim(1)=lonid - landfdim(2)=latid - status = nf_def_var (foutid,'landfract', NF_FLOAT, 2, landfdim, landfid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'lat', NF_DOUBLE, 1, latid, latvid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'lon', NF_DOUBLE, 1, lonid, lonvid) - if (status .ne. NF_NOERR) call handle_err(status) - -! -! Create attributes for output variables -! - status = nf_put_att_text (foutid,varianceid,'long_name', 29, 'variance of 30-sec elevations') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,varianceid,'units', 8, 'meter**2') - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,htopoid,'long_name', 41, '10-min elevation from USGS 30-sec dataset') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,htopoid,'units', 5, 'meter') - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,landfid,'long_name', 23, '10-minute land fraction') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,landfid,'units', 14, 'fraction (0-1)') - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,latvid,'long_name', 8, 'latitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,latvid,'units', 13, 'degrees_north') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,latvid,'units', 21, 'cell center locations') - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,lonvid,'long_name', 9, 'longitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,lonvid,'units', 12, 'degrees_east') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,lonvid,'units' , 21, 'cell center locations') - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,NF_GLOBAL,'source', 27, 'USGS 30-sec dataset GTOPO30') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,NF_GLOBAL,'title', 24, '10-minute USGS topo data') - if (status .ne. NF_NOERR) call handle_err(status) - call DATE_AND_TIME(DATE=datestring) - status = nf_put_att_text (foutid,NF_GLOBAL,'history',25, 'Written on date: ' // datestring ) - if (status .ne. NF_NOERR) call handle_err(status) - -! -! End define mode for output file -! - status = nf_enddef (foutid) - if (status .ne. NF_NOERR) call handle_err(status) -! -! Write variable for output -! - status = nf_put_var_double (foutid, varianceid, variance) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_var_double (foutid, htopoid, terr) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_var_double (foutid, landfid, land_fraction) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_var_double (foutid, latvid, latar) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_var_double (foutid, lonvid, lonar) - if (status .ne. NF_NOERR) call handle_err(status) - -! -! Close output file -! - status = nf_close (foutid) - if (status .ne. NF_NOERR) call handle_err(status) - - end subroutine wrtncdf -!************************************************************************ -!!handle_err -!************************************************************************ -! -!!ROUTINE: handle_err -!!DESCRIPTION: error handler -!-------------------------------------------------------------------------- - - subroutine handle_err(status) - - implicit none - -# include - - integer status - - if (status .ne. nf_noerr) then - print *, nf_strerror(status) - stop 'Stopped' - endif - - end subroutine handle_err - - diff --git a/tools/definehires/shr_kind_mod.F90 b/tools/definehires/shr_kind_mod.F90 deleted file mode 100644 index fc1ed8e94a..0000000000 --- a/tools/definehires/shr_kind_mod.F90 +++ /dev/null @@ -1,20 +0,0 @@ -!=============================================================================== -! CVS: $Id$ -! CVS: $Source$ -! CVS: $Name$ -!=============================================================================== - -MODULE shr_kind_mod - - !---------------------------------------------------------------------------- - ! precision/kind constants add data public - !---------------------------------------------------------------------------- - public - integer,parameter :: SHR_KIND_R8 = selected_real_kind(12) ! 8 byte real - integer,parameter :: SHR_KIND_R4 = selected_real_kind( 6) ! 4 byte real - integer,parameter :: SHR_KIND_RN = kind(1.0) ! native real - integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer - integer,parameter :: SHR_KIND_I4 = selected_int_kind ( 6) ! 4 byte integer - integer,parameter :: SHR_KIND_IN = kind(1) ! native integer - -END MODULE shr_kind_mod diff --git a/tools/definesurf/Makefile b/tools/definesurf/Makefile deleted file mode 100644 index dd13a5bdd4..0000000000 --- a/tools/definesurf/Makefile +++ /dev/null @@ -1,144 +0,0 @@ -# Makefile to build definesurf on various platforms -# Note: If netcdf library is not built in the standard location, you must set the environment -# variables INC_NETCDF and LIB_NETCDF - -EXEDIR = . -EXENAME = definesurf -RM = rm - -.SUFFIXES: -.SUFFIXES: .f90 .o - -# Check for the NetCDF library and include directories -ifeq ($(LIB_NETCDF),$(null)) -LIB_NETCDF := /usr/local/lib -endif - -ifeq ($(INC_NETCDF),$(null)) -INC_NETCDF := /usr/local/include -endif - -# Determine platform -UNAMES := $(shell uname -s) -UNAMEM := $(findstring CRAY,$(shell uname -m)) - -# Architecture-specific flags and rules -# -#------------------------------------------------------------------------ -# Cray -#------------------------------------------------------------------------ - -ifeq ($(UNAMEM),CRAY) -FC = f90 -FFLAGS = -c -I$(INC_NETCDF) -LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -.f90.o: - $(FC) $(FFLAGS) $< -endif - -#------------------------------------------------------------------------ -# SGI -#------------------------------------------------------------------------ - -ifeq ($(UNAMES),IRIX64) -FC = f90 -FFLAGS = -64 -c -I$(INC_NETCDF) -LDFLAGS = -64 -L/usr/local/lib64/r4i4 -lnetcdf -.f90.o: - $(FC) $(FFLAGS) $< -endif - -#------------------------------------------------------------------------ -# SUN -#------------------------------------------------------------------------ - -ifeq ($(UNAMES),SunOS) -FC = f90 -FFLAGS = -c -stackvar -f -I$(INC_NETCDF) -LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -.f90.o: - $(FC) $(FFLAGS) $< -endif - -#------------------------------------------------------------------------ -# AIX -#------------------------------------------------------------------------ - -ifeq ($(UNAMES),AIX) -FC = xlf90 -FFLAGS = -c -I$(INC_NETCDF) -LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -.f90.o: - $(FC) $(FFLAGS) -qsuffix=f=f90 $< -endif - -#------------------------------------------------------------------------ -# OSF1 -#------------------------------------------------------------------------ - -ifeq ($(UNAMES),OSF1) -FC = f90 -FFLAGS = -c -I$(INC_NETCDF) -LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -.f90.o: - $(FC) $(FFLAGS) $< -endif - -#------------------------------------------------------------------------ -# Linux -#------------------------------------------------------------------------ - -ifeq ($(UNAMES),Linux) -ifeq ($(USER_FC),$(null)) -FC := pgf90 -FFLAGS = -c -I$(INC_NETCDF) -fast -else -FC := $(USER_FC) -endif -LDFLAGS = -L$(LIB_NETCDF) -lnetcdf - -ifeq ($(FC),lf95) -FFLAGS = -c --trace --trap -I$(INC_NETCDF) -g -LDFLAGS += -g -endif - -.f90.o: - $(FC) $(FFLAGS) $< -endif - -#------------------------------------------------------------------------ -# Default rules and macros -#------------------------------------------------------------------------ - -OBJS := ao.o ao_i.o area_ave.o binf2c.o cell_area.o \ - chkdims.o endrun.o fmain.o handle_error.o inimland.o \ - lininterp.o map_i.o max_ovr.o shr_kind_mod.o sghphis.o sm121.o \ - terrain_filter.o varf2c.o wrap_nf.o interplandm.o map2f.o - -$(EXEDIR)/$(EXENAME): $(OBJS) - $(FC) -o $@ $(OBJS) $(LDFLAGS) - -clean: - $(RM) -f $(OBJS) *.mod $(EXEDIR)/$(EXENAME) - -ao.o: shr_kind_mod.o -ao_i.o: shr_kind_mod.o -area_ave.o: shr_kind_mod.o -binf2c.o: shr_kind_mod.o -cell_area.o: shr_kind_mod.o -chkdims.o: -endrun.o: -fmain.o: shr_kind_mod.o -handle_error.o: -inimland.o: shr_kind_mod.o -lininterp.o: shr_kind_mod.o -map_i.o: shr_kind_mod.o -max_ovr.o: shr_kind_mod.o -shr_kind_mod.o: -sghphis.o: shr_kind_mod.o -sm121.o: shr_kind_mod.o -terrain_filter.o: -map2f.o: -varf2c.o: shr_kind_mod.o -wrap_nf.o: -interplandm.o: diff --git a/tools/definesurf/README b/tools/definesurf/README deleted file mode 100644 index f0d9427e8e..0000000000 --- a/tools/definesurf/README +++ /dev/null @@ -1,156 +0,0 @@ -Running gnumake in this directory will create an executable named -"definesurf". Its function is to compute required CAM initial dataset -variables SGH, PHIS, and LANDFRAC from a high-resolution topography dataset, -and LANDM_COSLAT from a T42 "master", then add or replace the values on an -existing initial dataset. SGH is the standard deviation of PHIS used in the -gravity wave drag scheme. PHIS is the geopotential height. LANDFRAC is land -fraction. LANDM_COSLAT is a field derived from LANDFRAC which is required by -the prognostic cloud water parameterization. There is a cosine(latitude) -dependence built in to the function. - -The cam standard high resolution dataset is now based on the USGS -GTOPO30 digital elevation model at 30" resolution. It is converted to -10' resolution by definehires. - -The older high resolution topography dataset (10') used by definesurf -is named topo.nc and is included as part of the CAM distribution in -the datasets tar file. topo.nc was derived from the U.S. Navy Global -Elevation 10-MIN dataset DS754.0 Please refer to the following NCAR -website for more information: - -http://www.scd.ucar.edu/dss/catalogs/geo.html - -The algorithms within this code should be considered experimental. -For example, a 1-2-1 smoothing operator (sm121, called from subroutine -sghphis) is applied twice in succession to the topography variance -field regardless of horizontal resolution. Also, a spectral filter -will be applied to the PHIS field within the CAM at model startup -(except for the fv dycore) if PHIS was defined from the high -resolution topography dataset. The model determines this by checking -for the presence of netcdf attribute "from_hires" on variable PHIS. - -------------------------------------- -Feb 01, 2005 -------------------------------------- -------------------------------------- -*********** definesurf ************** -------------------------------------- - -A 10' data file is read in and averaged to the model grid by -definesurf. The present form of definesurf also takes a model initial -condition file as input and gets model grid description from it. The -terrain data mapped to the model grid is output on a new file. - -Command line flags are used for - -t name - (required) name of 10' data file - -g name - (required) name of cam initial condition file containing grid description - -l name - (required) name of land mask file on ?? grid - -r - (optional) do not extend Ross sea (default is extend) - -v - (optional) verbose (default is false) - -del2 - (optional) filter the elevations with a del2 filter (use for fv only) - -remap - (optional) filter the elevations with a remapping filter (use for fv only) - -sgh - (optional) filter the standard deviations with same filter as height - name - (required) name of i.c. file with existing terrain data, - must be final argument - -definesurf -t topo_gtopo30_10min.nc -g cami_*.nc -l landm_coslat.nc -remap oro_GTOPO30.nc -generates the file oro_GTOPO30.nc using the remapping filter. - -definesurf calls shgphis, which recognizes 2 input 10' data file formats - Old style, no 30" variance data on 10' grid, variance = -1 - land fraction called "ftopo" - New style, 30" variance data is present - land fraction called "landfract" - - Land fraction and 30" variance (if present) are averaged to the - model grid. - - if plon >= 128 then - Height is averaged to the model grid and the variance w.r.t to the - 10' data is computed. - if plon < 128 then - Height is averaged to a 3 degree grid and the variance w.r.t to the - 10' data is computed. The avg height and the variance of - the 3 degree data are then averaged to the model grid. - - 1-2-1 smoothers are applied twice to the model grid averaged values - of the two variance fields: 10' w.r.t. model grid; 30" w.r.t. 10' - (if 30" variance is present). - - The averaged and smoothed variances are converted to standard - deviations. - - The averaged height is converted to a geopotential (z*9.80616) - -Attributes are added to input file to describe what definesurf is doing. - -Land mask for clouds is interpolated to model grid. - -Extend land to -79 degrees for Ross ice shelf, unless -r flag was -set. - -Run terrain filter, if requested (-remap or -del2). Should only be -done for fv grids. For spectral grid, filtering is done in the model -based on the value of the attribute "from_hires". - Diffusive filter or remapping is appled to - surface geopotential - standard deviation of 10' data w.r.t. model grid - standard deviation of 30" data w.r.t. 10' grid (if present) - -**** It is not clear that the filter should be applied to the -**** standard deviations. - - The remapping filter removes structure near grid scale by using the - ppm mapping code to go to a half resolution grid and back to the - full resolution grid. Order (accuracy) parameters iord=7 and jord=3 - are used. A polar filter is also applied. - -------------------------------------------------------- -******* diffusive (-del2) terrain filter notes ******** -------------------------------------------------------- - -The del2 filter is a bit of a pain to figure out from the code (as is the -spectral one applied in the model for eul and sld dycores). It looks like - -(1) h(n+1) = h(n) + c*del2(h(n)), c=0.25 - -del2(h) = div(grad(h)) - -however, buried inside the del2 routine is a scaling by -CD = 0.25*DL*DP*coszc**2, - -coszc = cos(60*pi/180) [= 0.5] -DL = 2*pi/NLON is delta lambda -DP = pi / (NLAT-1) is delta phi -so -CD = 0.0625 * 2*pi/NLON * pi/(NLAT-1) = 0.4 / NLON / (NLAT-1) - -So the scaling factor reduces as the square of the resolution, just like -a del2 coefficient should, in order to maintain a constant damping rate -at the truncation limit. -CD = 3E-5, for 2x2.5 - -However, the number of iterations is NLON/12, so there is an additional -scaling upward of diffusion with resolution. - -going back to (1) -h(n+1) = h(n) + c*CD*del2(h(n)) -c*CD = 7.57E-6 for 2x2.5 -c*CD is just dt*k for a normal diffusion equation, where dt is the time -step and k is the diffusivity on the unit sphere. For a sphere with -radius a (=6.37E6), the diffusivity is K=k*a**2 . -Then dt*K = c*CD*a**2 = 3E8 and assuming dt=3600, K = 8.5E4 - -The del4 diffusivity in the spectral case is 5E15 at T63. The equivalent -del2 coefficient is K = 5E15 * 63*64/a**2 = 5E5 to damp wave 63 at the -same rate. - -So, we have K_fv ~ 8.5E4 and K_eul ~ 5E5. So the fv damping should -actually be less than the spectral/eulerian damping. - -Also, the damping is applied 25 times in the spectral case and NLON/12 -times for fv. NLON/12 =12 for 2x2.5, =24 for 1x1.25 and =48 for -0.5x0.625. - -The big difference is that the spectral/eulerian actually uses del4, -which confines the damping much closer to grid scale. diff --git a/tools/definesurf/ao.f90 b/tools/definesurf/ao.f90 deleted file mode 100644 index 33d7494215..0000000000 --- a/tools/definesurf/ao.f90 +++ /dev/null @@ -1,141 +0,0 @@ -subroutine ao (nlon_i , nlat_i , numlon_i, lon_i , lat_i , & - nlon_o , nlat_o , numlon_o, lon_o , lat_o , & - area_o , re , mx_ovr , n_ovr , i_ovr , & - j_ovr , w_ovr ) - - use shr_kind_mod, only: r8 => shr_kind_r8 - -! ----------------------------------------------------------------- - implicit none -! ------------------------ code history --------------------------- -! source file: ao.F -! purpose: weights and indices for area of overlap between -! input and output grids -! date last revised: March 1996 -! author: Gordon Bonan -! standardized: -! reviewed: -! ----------------------------------------------------------------- - -! ------------------- input variables ----------------------------- - integer nlon_i !maximum number of input longitude points - integer nlat_i !number of input latitude points - integer numlon_i(nlat_i) !number of input lon pts for each latitude - integer nlon_o !maximum number of output longitude points - integer nlat_o !number of output latitude points - integer numlon_o(nlat_o) !number of output lon pts for each latitude - integer mx_ovr !maximum number of overlapping input cells - - real(r8) lon_i(nlon_i+1,nlat_i) !input grid cell longitude, w. edge (deg) - real(r8) lon_o(nlon_o+1,nlat_o) !output grid cell longitude, w. edge (deg) - real(r8) lat_i(nlat_i+1) !input grid cell latitude, s. edge (deg) - real(r8) lat_o(nlat_o+1) !output grid cell latitude, s. edge (deg) - real(r8) area_o(nlon_o,nlat_o) !area of output grid cell - real(r8) re !radius of earth -! ----------------------------------------------------------------- - -! ------------------- input/output variables ---------------------- - integer n_ovr(nlon_o,nlat_o ) !number of overlapping input cells - integer i_ovr(nlon_o,nlat_o,mx_ovr) !lon index, overlapping input cell - integer j_ovr(nlon_o,nlat_o,mx_ovr) !lat index, overlapping input cell - - real(r8) w_ovr(nlon_o,nlat_o,mx_ovr) !overlap weights for input cells -! ----------------------------------------------------------------- - -! ------------------- local variables ----------------------------- - integer io,ii !output and input grids longitude loop index - integer jo,ji !output and input grids latitude loop index - - real(r8) lonw,lone,dx !west, east longitudes of overlap and difference - real(r8) lats,latn,dy !south, north latitudes of overlap and difference - real(r8) deg2rad !pi/180 - real(r8) a_ovr !area of overlap - real(r8) zero,one - parameter (zero=0.0) ! Needed as arg to "max" - parameter (one=1.) ! Needed as arg to "atan" -! ----------------------------------------------------------------- - - deg2rad = (4.*atan(one)) / 180. - -! ----------------------------------------------------------------- -! for each output grid cell: find overlapping input grid cell and area of -! input grid cell that overlaps with output grid cell. cells overlap if: -! -! southern edge of input grid < northern edge of output grid AND -! northern edge of input grid > southern edge of output grid -! -! western edge of input grid < eastern edge of output grid AND -! eastern edge of input grid > western edge of output grid -! -! lon_o(io,jo) lon_o(io+1,jo) -! -! | | -! --------------------- lat_o(jo+1) -! | | -! | | -! xxxxxxxxxxxxxxx lat_i(ji+1) | -! x | x | -! x input | x output | -! x cell | x cell | -! x ii,ji | x io,jo | -! x | x | -! x ----x---------------- lat_o(jo ) -! x x -! xxxxxxxxxxxxxxx lat_i(ji ) -! x x -! lon_i(ii,ji) lon_i(ii+1,ji) -! ----------------------------------------------------------------- - -! note that code does not vectorize but is only called during -! initialization. - - do jo = 1, nlat_o - do io = 1, numlon_o(jo) - -! loop through all input grid cells to find overlap with output grid. - - do ji = 1, nlat_i - if ( lat_i(ji ).lt.lat_o(jo+1) .and. & - lat_i(ji+1).gt.lat_o(jo ) ) then !lat ok - - do ii = 1, numlon_i(ji) - if ( lon_i(ii ,ji).lt.lon_o(io+1,jo) .and. & - lon_i(ii+1,ji).gt.lon_o(io ,jo) ) then !lon okay - -! increment number of overlapping cells. make sure 0 < n_ovr < mx_ovr - - n_ovr(io,jo) = n_ovr(io,jo) + 1 -! if (n_ovr(io,jo) .gt. mx_ovr) then -! write (6,*) 'AO error: n_ovr= ',n_ovr(io,jo), & -! ' exceeded mx_ovr = ',mx_ovr, & -! ' for output lon,lat = ',io,jo -! call endrun -! end if - -! determine area of overlap - - lone = min(lon_o(io+1,jo),lon_i(ii+1,ji))*deg2rad !e edge - lonw = max(lon_o(io ,jo),lon_i(ii ,ji))*deg2rad !w edge - dx = max(zero,(lone-lonw)) - latn = min(lat_o(jo+1),lat_i(ji+1))*deg2rad !n edge - lats = max(lat_o(jo ),lat_i(ji ))*deg2rad !s edge - dy = max(zero,(sin(latn)-sin(lats))) - a_ovr = dx*dy*re*re - -! determine indices and weights. re cancels in the division by area - - i_ovr(io,jo,n_ovr(io,jo)) = ii - j_ovr(io,jo,n_ovr(io,jo)) = ji - w_ovr(io,jo,n_ovr(io,jo)) = a_ovr/area_o(io,jo) - - end if - end do - - end if - end do - - end do - end do - - return -end subroutine ao diff --git a/tools/definesurf/ao_i.f90 b/tools/definesurf/ao_i.f90 deleted file mode 100644 index 87b96eb815..0000000000 --- a/tools/definesurf/ao_i.f90 +++ /dev/null @@ -1,178 +0,0 @@ -subroutine ao_i(nlon_i , nlat_i , numlon_i, lon_i , lat_i , & - nlon_o , nlat_o , numlon_o, lon_o , lat_o , & - mx_ovr , i_ovr , j_ovr , w_ovr , re , & - area_o , relerr ) - - use shr_kind_mod, only: r8 => shr_kind_r8 - -! ----------------------------------------------------------------- - implicit none -! ------------------------ code history --------------------------- -! source file: ao_i.F -! purpose: area averaging initialization: indices and weights -! date last revised: November 1996 -! author: Gordon Bonan -! standardized: -! reviewed: -! ----------------------------------------------------------------- - -! ------------------------ notes ---------------------------------- -! get indices and weights for area-averaging between input and output grids - -! o input grid does not have to be finer resolution than output grid - -! o both grids must be oriented south to north, i.e., cell(lat+1) -! must be north of cell(lat). the southern edge of the first row -! must be -90 (south pole) and the northern edge of the last row -! must be +90 (north pole) - -! o both grids must be oriented eastwards, i.e., cell(lon+1) must be -! east of cell(lon). but the two grids do not have to start at the -! same longitude, i.e., one grid can start at dateline and go east; -! the other grid can start at greenwich and go east. longitudes for -! the western edge of the cells must increase continuously and span -! 360 degrees. examples -! dateline : -180 to 180 (- longitudes west of greenwich) -! greenwich : 0 to 360 -! greenwich (centered): -dx/2 to -dx/2 + 360 (- longitudes west of greenwich) - -! for each output grid cell -! o number of input grid cells that overlap with output grid cell (n_ovr) -! o longitude index (1 <= i_ovr <= nlon_i) of the overlapping input grid cell -! o latitude index (1 <= j_ovr <= nlat_i) of the overlapping input grid cell - -! for field values fld_i on an input grid with dimensions nlon_i and nlat_i -! field values fld_o on an output grid with dimensions nlon_o and nlat_o are -! fld_o(io,jo) = -! fld_i(i_ovr(io,jo, 1),j_ovr(io,jo, 1)) * w_ovr(io,jo, 1) + -! ... + ... + -! fld_i(i_ovr(io,jo,mx_ovr),j_ovr(io,jo,mx_ovr)) * w_ovr(io,jo,mx_ovr) - -! error check: overlap weights of input cells sum to 1 for each output cell -! ----------------------------------------------------------------- - -! ------------------- input variables ----------------------------- - integer nlon_i !input grid max number of input longitude points - integer nlat_i !input grid number of input latitude points - integer numlon_i(nlat_i) !input grid number of lon points for each lat - integer nlon_o !output grid max number of output lon points - integer nlat_o !output grid number of output latitude points - integer numlon_o(nlat_o) !output grid number of lon points for each lat - integer mx_ovr !max num of input cells that overlap output cell - - real(r8) lon_i(nlon_i+1,nlat_i) !input grid cell lon, western edge (degrees) - real(r8) lon_o(nlon_o+1,nlat_o) !output grid cell lon, western edge (degrees) - real(r8) lat_i(nlat_i+1) !input grid cell lat, southern edge (degrees) - real(r8) lat_o(nlat_o+1) !output grid cell lat, southern edge (degrees) - real(r8) area_o(nlon_o,nlat_o) !cell area on output grid - real(r8) re !radius of earth - real(r8) relerr !max error: sum overlap weights ne 1 -! ----------------------------------------------------------------- - -! ------------------- output variables ---------------------------- - integer i_ovr(nlon_o,nlat_o,mx_ovr) !lon index, overlapping input cell - integer j_ovr(nlon_o,nlat_o,mx_ovr) !lat index, overlapping input cell - real(r8) w_ovr(nlon_o,nlat_o,mx_ovr) !overlap weights for input cells -! ----------------------------------------------------------------- - -! ------------------- local variables ----------------------------- - integer io,ii !input and output grids longitude loop index - integer jo,ji !input and output grids latitude loop index - integer n !overlapping cell index - - real(r8) offset !used to shift x-grid 360 degrees - real(r8) f_ovr !sum of overlap weights for cells on output grid -! -! Dynamic -! - integer n_ovr(nlon_o,nlat_o) !number of overlapping input cells - -! ----------------------------------------------------------------- -! initialize overlap weights on output grid to zero for maximum -! number of overlapping points. set lat and lon indices of overlapping -! input cells to dummy values. set number of overlapping cells to zero -! ----------------------------------------------------------------- - - do n = 1, mx_ovr - do jo = 1, nlat_o - do io = 1, numlon_o(jo) - i_ovr(io,jo,n) = 1 - j_ovr(io,jo,n) = 1 - w_ovr(io,jo,n) = 0. - end do - end do - end do - - do jo = 1, nlat_o - do io = 1, numlon_o(jo) - n_ovr(io,jo) = 0 - end do - end do - -! ----------------------------------------------------------------- -! first pass to find cells that overlap, area of overlap, and weights -! ----------------------------------------------------------------- - - call ao (nlon_i , nlat_i , numlon_i, lon_i , lat_i , & - nlon_o , nlat_o , numlon_o, lon_o , lat_o , & - area_o , re , mx_ovr , n_ovr , i_ovr , & - j_ovr , w_ovr ) - -! ----------------------------------------------------------------- -! second pass to find cells that overlap, area of overlap, and weights -! ----------------------------------------------------------------- - -! shift x-grid to locate periodic grid intersections -! the following assumes that all lon_i(1,:) have the same value -! independent of latitude and that the same holds for lon_o(1,:) - - if (lon_i(1,1) .lt. lon_o(1,1)) then - offset = 360.0 - else - offset = -360.0 - end if - - do ji = 1,nlat_i - do ii = 1, numlon_i(ji) + 1 - lon_i(ii,ji) = lon_i(ii,ji) + offset - end do - end do - -! find overlap - - call ao (nlon_i , nlat_i , numlon_i , lon_i , lat_i , & - nlon_o , nlat_o , numlon_o , lon_o , lat_o , & - area_o , re , mx_ovr , n_ovr , i_ovr , & - j_ovr , w_ovr ) - -! restore x-grid (un-shift x-grid) - - do ji = 1,nlat_i - do ii = 1, numlon_i(ji) + 1 - lon_i(ii,ji) = lon_i(ii,ji) - offset - end do - end do - -! ----------------------------------------------------------------- -! error check: overlap weights for input grid cells must sum to 1 -! ----------------------------------------------------------------- - - do jo = 1, nlat_o - do io = 1, numlon_o(jo) - f_ovr = 0. - - do n = 1, mx_ovr - f_ovr = f_ovr + w_ovr(io,jo,n) - end do - - if (abs(f_ovr-1.) .gt. relerr) then - write (6,*) 'AO_I error: area not conserved for',' lon,lat = ', io,jo - write (6,'(a30,e20.10)') ' sum of overlap weights = ', f_ovr - call endrun - end if - - end do - end do - - return -end subroutine ao_i diff --git a/tools/definesurf/area_ave.f90 b/tools/definesurf/area_ave.f90 deleted file mode 100644 index cbcdbcd3af..0000000000 --- a/tools/definesurf/area_ave.f90 +++ /dev/null @@ -1,59 +0,0 @@ -subroutine area_ave (nlat_i , nlon_i , numlon_i, fld_i , & - nlat_o , nlon_o , numlon_o, fld_o , & - i_ovr , j_ovr , w_ovr , nmax ) - - use shr_kind_mod, only: r8 => shr_kind_r8 - - implicit none -! ------------------------ code history --------------------------- -! source file: area_ave.F -! purpose: area averaging of field from input to output grids -! date last revised: November 1996 -! author: Gordon Bonan -! standardized: -! reviewed: -! ----------------------------------------------------------------- - -! ------------------- input variables ----------------------------- - integer nlat_i ! number of latitude points for input grid - integer nlat_o ! number of latitude points for output grid - integer nlon_i ! maximum number of longitude points for input grid - integer nlon_o ! maximum number of longitude points for output grid - integer nmax ! maximum number of overlapping cells - integer numlon_i(nlat_i) ! input grid number of lon points at each lat - integer numlon_o(nlat_o) ! input grid number of lon points at each lat - integer i_ovr(nlon_o,nlat_o,nmax) ! lon index, overlapping input cell - integer j_ovr(nlon_o,nlat_o,nmax) ! lat index, overlapping input cell - - real(r8) fld_i(nlon_i,nlat_i) !field for input grid - real(r8) w_ovr(nlon_o,nlat_o,nmax) ! overlap weights for input cells -! ----------------------------------------------------------------- - -! ------------------- output variables ---------------------------- - real(r8) fld_o(nlon_o,nlat_o) !field for output grid -! ----------------------------------------------------------------- - -! ------------------- local variables ----------------------------- - integer jo,ji !latitude index for output,input grids - integer io,ii !longitude index for output,input grids - integer n !overlapping cell index -! ----------------------------------------------------------------- - - do jo = 1, nlat_o - do io =1, numlon_o(jo) - fld_o(io,jo) = 0. - end do - end do - - do n = 1, nmax - do jo = 1, nlat_o - do io =1, numlon_o(jo) - ii = i_ovr(io,jo,n) - ji = j_ovr(io,jo,n) - fld_o(io,jo) = fld_o(io,jo) + w_ovr(io,jo,n)*fld_i(ii,ji) - end do - end do - end do - - return -end subroutine area_ave diff --git a/tools/definesurf/binf2c.f90 b/tools/definesurf/binf2c.f90 deleted file mode 100644 index f43ca19ee4..0000000000 --- a/tools/definesurf/binf2c.f90 +++ /dev/null @@ -1,218 +0,0 @@ -subroutine binf2c(flon , flat ,nflon ,nflat ,fine , & - clon , clat ,nclon ,nclat ,cmean ) - - use shr_kind_mod, only: r8 => shr_kind_r8 - -!----------------------------------------------------------------------------- -! Bin going from a fine grid to a coarse grid. -! A schematic for the coarse and fine grid systems is shown in -! Figure 1. This code assumes that each data point is represent -! it's surrounding area, called a cell. The first grid data point -! for both grids is assumed to be located at 0E (GM). This -! implies that the 1st cell for both the fine and the coarse grids -! strattles the Greenwich Meridian (GM). This code also assumes -! that there is no data wraparound (last data value is located at -! 360-dx). -! -! FIGURE 1: Overview of the coarse (X) and fine (@) grids -! longitudinal structure where: -! X = location of each coarse grid data point -! @ = location of each fine grid data point -! -! Greenwich Greenwich -! 0 Coarse cells 360 -! : v : -! clon(1): clon(2) v clon(3) clon(nclon): -! v : v v v v : -! xxxxxxxxxxxxxxxxxxxxxxxxxxxx..xxxxxxxxxxxxxxxx : -! x x x x x : -! x x x x x : -! x c(1) x c(2) x x c(nclon)x : -! x X x X x x X x : -! x ___ ___ ___ ___ ___ ___ ___ ___ ___ ___ ___ : -! x | | | | | | | | | | | | | : -! x | @ | @ | @ | @ | @ | @ |..| @ | @ | @ | @ | @ | : -! xxx|___|___|___|___|___|___| |___|___|___|___|___| : -! v v v v v : -! flon(1) flon(3) v flon(nflon-1) flon(nflon) -! : v : -! : Fine cells : -! 0 360 -! -! The Longitude/Latitude search: -! ------------------------------ -! -! Given a coarse grid cell with west and east boundaries of cWest -! and cEast and south and north boundaries of cSouth and cNorth -! (outlined by "x" in figure 2), find the indices of the fine grid -! points which are contained within the coarse grid cell. imin and -! imax are the indices fine grid points which overlap the western -! and eastern boundary of the coarse cell. jmin and jmax are the -! corresponding indices in the S-N direction. Bin these overlapping -! values to generate coarse(n), the coarse grid data values. -! -! FIGURE 2: Detail of Coarse and Fine cell overlap. -! @ = fine grid data point -! X = coarse grid data point -! -! cWest cEast -! | | x | | x | -! -@-------@---x---@-------@-----x-@- -! | | x*xxxxxxxxxxxxxxxxx*x|xx cNorth -! | | x | | x | -! | | x | | x | -! @-------@---x---@-------@-----x-@- jmax -! | | x | c(n) | x | -! | @ | x | | x | -! | | x | | x | -! @-------@---x---@-------@-----x-@- jmin -! | | x | | x | -! | @ | x*xxxxxxx@xxxxxxxxx*x|xx cSouth -! | | x | | x | -! -@-------@---x---@-------@-----x-@- -! | imin imax | -! -! -! When a cell coarse cell strattles the Greenwich Meridian -! --------------------------------------------------------- -! -! The first coarse grid cell strattles the GM, so when the western -! boundary of the coarse cell is < 0, an additional search is carried out. -! It ASSUMES that the easternmost fine grid point overlaps and searches -! westward from nflon, looking for a grid point west of clon(1) -! This generates a second set of longitudinal indices, imin1 and imax1. -! See Figure 3. -! -! Figure 3: Detail of Coarse cell strattling GM: -! ----------------------------------------------- -! -! Greenwich Greenwich -! 0 360 -! cWest : cEast cWest : -! clon(1): clon(2) clon(nclon+1)=clon(1) -! v : v v : -! xxxxxxxxxxxxxxxxxxxxxxx ... xxxxxxxxxxxxxxxx : -! x x x x x : -! x x x x x : -! x c(1) x x x c(nclon)x : -! x X x x x X x : -! x ___ ___ ___ _ ___ ___ ___ : -! x | | | | | | | : -! x | @ | @ | @ | @ | @ | @ | : -! xxx|___|___|___|_ ___|___|___| : -! ^ : ^ ^ ^ ^ : -! flon(1): ^ flon(3) flon(nflon-1) ^ : -! ^ : ^ ^ ^ : -! ^ :flon(2) ^ flon(nflon) -! ^ : ^ ^ ^ : -! imin : imax imin1 imax1 : -! : : -! -! -! In this case, imin=1, imax=2, imin1=nflon-1 and imax1=nflon. -! because the last two cells of the fine grid will have some -! contribution the the 1st cell of the coarse grid. -! -!----------------------------------------------------------------------- - implicit none -!-----------------------------Arguments--------------------------------- - - integer nflon ! Input: number of fine longitude points - integer nflat ! Input: number of fine latitude points - integer nclon ! Input: number of coarse longitude points - integer nclat ! Input: number of coarse latitude points - - real(r8) flon(nflon) ! Input: fine grid lons, centers (deg) - real(r8) flat(nflat) ! Input: fine grid lats, centers (deg) - real(r8) fine(nflon,nflat) ! Input: Fine grid data array - real(r8) clon(nclon+1,nclat) ! Input: coarse grid cell lons, west edge (deg) - real(r8) clat(nclat+1) ! Input: coarse grid cell lat, south edge (deg) - real(r8) cmean(nclon,nclat) ! Output: mean of fine grid points over coarse cell - -!--------------------------Local variables------------------------------ - - real(r8) cWest ! Coarse cell longitude, west edge (deg) - real(r8) cEast ! Coarse cell longitude, east edge (deg) - real(r8) cSouth ! Coarse cell latitude, south edge (deg) - real(r8) cNorth ! Coarse cell latitude, notrh edge (deg) - real(r8) sum ! coarse tmp value - - integer i,j ! Indices - integer imin ,imax ! Max/Min E-W indices of intersecting fine cell. - integer imin1,imax1 ! fine E-W indices when coarse cell strattles GM - integer jmin ,jmax ! Max/Min N-S indices of intersecting fine cell. - integer iclon,jclat ! coarse grid indices - integer num ! increment - -!----------------------------------------------------------------------------- - - do jclat= 1,nclat ! loop over coarse latitudes - cSouth = clat(jclat) - cNorth = clat(jclat+1) - - do iclon=1,nclon ! loop over coarse longitudes - cWest = clon(iclon,jclat) - cEAST = clon(iclon+1,jclat) - -! 1. Normal longitude search: Find imin and imax - - imin = 0 - imax = 0 - do i=1,nflon-1 ! loop over fine lons, W -> E - if (flon(i) .gt. cEast) goto 10 ! fine grid point is E of coarse box - if (flon(i) .ge. cWest .and. imin.eq.0) imin=i - imax=i - enddo - -! 2. If cWest < 0, then coarse cell strattles GM. Hunt westward -! from the end to find indices of any overlapping fine grid cells: -! imin1 and imax1. - -10 imin1 = 0 ! borders for cWest, cEast - imax1 = -1 ! borders for cWest, cEast - if (cWest .lt. 0) then - cWest = cWest + 360. - imax1 = nflon - do i=nflon,1,-1 ! loop over fine lons, E -> W - imin1=i - if (flon(i) .le. cWest) goto 20 ! fine grid point is W of coarse box - enddo - endif - -! 3. Do the latitude search S -> N for jmin and jmax - -20 jmin = 0 - jmax = 0 - do j=1,nflat ! loop over fine lats, S -> N - if (flat(j) .gt. cNorth) goto 30 ! fine grid point is N of coarse box - if (flat(j) .ge. cSouth .and. jmin.eq.0) jmin=j - jmax=j - enddo -30 continue - -! 4. Sum - - sum = 0. ! Initialize coarse data value - num = 0 - - do j=jmin,jmax ! loop over fine lats, S -> N - do i=imin,imax ! loop over fine lons, W -> E - sum = sum + fine(i,j) - num = num + 1 - enddo - do i=imin1,imax1 ! If coarse cell strattles GM - sum = sum + fine(i,j) - num = num + 1 - enddo - enddo - - if (num .gt. 0) then - cmean(iclon,jclat) = sum/num - else - cmean(iclon,jclat) = 1.e30 - endif - - end do - end do - return -end subroutine binf2c diff --git a/tools/definesurf/cell_area.f90 b/tools/definesurf/cell_area.f90 deleted file mode 100644 index 2e8272aaeb..0000000000 --- a/tools/definesurf/cell_area.f90 +++ /dev/null @@ -1,51 +0,0 @@ -subroutine cell_area (nlat, nlon, numlon, lon_w, lat_s, re, area) - - use shr_kind_mod, only: r8 => shr_kind_r8 - - implicit none -! ------------------------ code history --------------------------- -! source file: cell_area.F -! purpose: area of grid cells -! date last revised: March 1996 -! author: Gordon Bonan -! standardized: -! reviewed: -! ----------------------------------------------------------------- - -! ------------------- input variables ----------------------------- - integer nlat !number of latitude points - integer nlon !maximum number of longitude points - integer numlon(nlat) !number of longitude points for each latitude - real(r8) lon_w(nlon+1,nlat) !grid cell longitude, western edge (degrees) - real(r8) lat_s(nlat+1) !grid cell latitude, southern edge (degrees) -! ----------------------------------------------------------------- - -! ------------------- output variables ---------------------------- - real(r8) re !radius of earth (km) - real(r8) area(nlon,nlat) !cell area (km**2) -! ----------------------------------------------------------------- - -! ------------------- local variables ----------------------------- - integer i !longitude index - integer j !latitude index - - real(r8) dx !cell width - real(r8) dy !cell length - real(r8) deg2rad !pi/180 - real(r8) one - parameter (one=1.) ! Argument to atan -! ----------------------------------------------------------------- - - deg2rad = (4.*atan(one)) / 180. - re = 6371.227709 - - do j = 1, nlat - do i = 1, numlon(j) - dx = (lon_w(i+1,j)-lon_w(i,j)) * deg2rad - dy = sin(lat_s(j+1)*deg2rad) - sin(lat_s(j)*deg2rad) - area(i,j) = dx*dy*re*re - end do - end do - - return -end subroutine cell_area diff --git a/tools/definesurf/chkdims.f90 b/tools/definesurf/chkdims.f90 deleted file mode 100644 index cb9be4ce32..0000000000 --- a/tools/definesurf/chkdims.f90 +++ /dev/null @@ -1,52 +0,0 @@ -subroutine chkdims (fileid, name, varid, londimid, latdimid, timdimid, verbose) - - implicit none - - include 'netcdf.inc' - - integer fileid, varid, londimid, latdimid - integer timdimid - logical verbose - character*(*) name - - integer ret - integer ndims, dimids(nf_max_dims) - - ret = nf_inq_varid (fileid, name, varid) - - if (ret.eq.NF_NOERR) then - - dimids(:) = -999 - ret = nf_inq_varndims (fileid, varid, ndims) - ret = nf_inq_vardimid (fileid, varid, dimids) - - if (ret.ne.NF_NOERR) then - write(6,*)'NF_INQ_VAR failed for ',name - call handle_error (ret) - end if - - if (ndims.eq.3 .and. dimids(3).ne.timdimid) then - write(6,*)'3rd dim of ', name, ' must be time' - call endrun - end if - - if (dimids(1).ne.londimid .or. dimids(2).ne.latdimid) then - write(6,*)'Dims of ', name,' must be lon by lat' - call endrun - end if - - if (verbose) write(6,*)'Overwriting existing ',name,' with hi-res topo' - - else - - dimids(1) = londimid - dimids(2) = latdimid - dimids(3) = timdimid - if (verbose) write(6,*)name,' does not exist on netcdf file: Creating.' - ret = nf_redef (fileid) - ret = nf_def_var (fileid, name, NF_DOUBLE, 3, dimids, varid) - if (ret.ne.NF_NOERR) call handle_error (ret) - ret = nf_enddef (fileid) - - end if -end subroutine chkdims diff --git a/tools/definesurf/endrun.f90 b/tools/definesurf/endrun.f90 deleted file mode 100644 index 71b2194a6f..0000000000 --- a/tools/definesurf/endrun.f90 +++ /dev/null @@ -1,7 +0,0 @@ -subroutine endrun - implicit none - include 'netcdf.inc' - - call abort - stop 999 -end subroutine endrun diff --git a/tools/definesurf/fmain.f90 b/tools/definesurf/fmain.f90 deleted file mode 100644 index c14b337c64..0000000000 --- a/tools/definesurf/fmain.f90 +++ /dev/null @@ -1,458 +0,0 @@ -program fmain - - use shr_kind_mod, only: r8 => shr_kind_r8 - - implicit none - - include 'netcdf.inc' -! -! Local workspace -! - real(r8), parameter :: fillvalue = 1.d36 - real(r8), parameter :: filter_coefficient = 0.25D0 - - character(len=128) :: topofile = ' ' ! input high resolution (10 min) file name - character(len=128) :: landmfile = ' ' ! input land mask file name - character(len=128) :: gridfile = ' ' ! input initial condition file with grid definition - character(len=128) :: outbcfile = ' ' ! output boundary condition file with PHIS, SGH, etc. - character(len= 80) :: arg ! used for parsing command line arguments - character(len=256) :: cmdline ! input command line - character(len=256) :: history ! history attribute text - character(len= 8) :: datestring - character(len= 32) :: z_filter_type ! type of filter applied to height - character(len= 32) :: s_filter_type ! type of filter applied to standard deviations - - logical verbose ! Add print statements - logical make_ross ! Make Ross ice shelf south of -79 - logical filter_del2 ! Execute SJ Lin's del2 terrain filter - logical filter_remap ! Execute SJ Lin's newer remapping terrain filter - logical filter_sgh ! Filter SGH and SGH30 in addition to height - logical reduced_grid ! reduced grid defined - logical have_sgh30 ! input topofile has sgh30, output will also - - integer cmdlen ! character array lengths - integer gridid - integer foutid ! output file id - integer lonid, londimid, rlonid ! longitude dimension variable ids - integer latid, latdimid ! latitude dimension variable ids - integer sghid, phisid, landfid, nlonid, landmid, sgh30id ! output variable netcdf ids - integer start(4), count(4) - integer plon, nlat - integer i, j - integer ret - integer nargs ! input arg - integer n ! index loops thru input args - - integer dim(2) ! dimension list for output variables - - integer , allocatable :: nlon(:) - real(r8), allocatable :: mlatcnts(:) ! model cell center latitudes - real(r8), allocatable :: mloncnts(:,:) ! model cell center longitudes - real(r8), allocatable :: sgh(:,:) - real(r8), allocatable :: sgh30(:,:) - real(r8), allocatable :: phis(:,:) - real(r8), allocatable :: fland(:,:) - real(r8), allocatable :: landm(:,:) - - integer iargc - external iargc -! -! Default settings before parsing argument list -! - verbose = .false. - make_ross = .true. - filter_del2 = .false. - filter_remap = .false. - filter_sgh = .false. - reduced_grid = .false. - -! parse input arguments - - nargs = iargc() - n = 1 - cmdline = char(10) // 'definesurf ' - do while (n .le. nargs) - arg = ' ' - call getarg (n, arg) - n = n + 1 - - select case (arg) -! topography file name (10') - case ('-t') - call getarg (n, arg) - n = n + 1 - topofile = arg - cmdline = trim(cmdline) // ' -t ' // trim(topofile) -! grid file name - case ('-g') - call getarg (n, arg) - n = n + 1 - gridfile = arg - cmdline = trim(cmdline) // ' -g ' // trim(gridfile) -! verbose mode - case ('-v') - verbose = .true. - cmdline = trim(cmdline) // ' -v' -! landmask file name - case ('-l') - call getarg (n, arg) - n = n + 1 - landmfile = arg - cmdline = trim(cmdline) // ' -l ' // trim(landmfile) -! extend Ross Sea - case ('-r') - make_ross = .false. - cmdline = trim(cmdline) // ' -r' -! use del2 filter on heights - case ('-del2') - filter_del2 = .true. - cmdline = trim(cmdline) // ' -del2' -! use remap filter on heights - case ('-remap') - filter_remap = .true. - cmdline = trim(cmdline) // ' -remap' -! apply filter to sgh (and sgh30) in addition to height - case ('-sgh') - filter_sgh = .true. - cmdline = trim(cmdline) // ' -sgh' -! not one of the above, must be output file name - case default - if (outbcfile .eq. ' ') then - outbcfile = arg - else - write (6,*) 'Argument ', arg,' is not known' - call usage_exit (' ') - end if - cmdline = trim(cmdline) // ' ' // trim(arg) - end select - end do - - if (outbcfile == ' ') then - call usage_exit ('Must enter an output file name') - end if - - if (gridfile == ' ') then - call usage_exit ('Must enter gridfile name via -g arg (can use a model history file)') - end if - - if (topofile == ' ') then - call usage_exit ('Must enter topofile name via -t arg') - end if - - if (filter_remap .and. filter_del2) then - write(6,*)'Both filter_remap and filter_del2 set: using filter_remap' - end if - - if (.not. filter_remap .and. .not. filter_del2) then - write(6,*)'No filter being applied to height field' - if (filter_sgh) call usage_exit ('Must filter height to filter sgh') - end if - - if (landmfile == ' ') then - call usage_exit ('Must enter landmfile name via -l arg') - end if - -! Open the grid file - ret = nf_open (trim(gridfile), nf_nowrite, gridid) - if (ret /= nf_noerr) then - write(6,*)nf_strerror(ret) - write(6,*)'Unable to open input file ', trim(gridfile), ' for writing' - stop 999 - end if - -! Get the grid dimensions from the grid file - call wrap_inq_dimid (gridid, 'lon', londimid) - call wrap_inq_dimlen (gridid, londimid, plon ) - call wrap_inq_dimid (gridid, 'lat', latdimid) - call wrap_inq_dimlen (gridid, latdimid, nlat ) -! -! Get longitude and latitude arrays for model grid. -! If reduced grid, 2-d variable containing lon values for each lat is called "rlon". -! First allocate space for dynamic arrays now that sizes are known -! - allocate (nlon(nlat)) - allocate (mlatcnts(nlat)) - allocate (mloncnts(plon,nlat)) - - if (nf_inq_varid (gridid, 'nlon', nlonid) == nf_noerr) then - if (nf_get_var_int (gridid, nlonid, nlon) /= nf_noerr) then - write(6,*)'nf_get_var_int() failed for nlon' - call endrun - end if - reduced_grid = .true. - else - nlon(:) = plon - end if - - do j=1,nlat - if (nlon(j)<1 .or. nlon(j)>plon) then - write(6,*)'nlon(',j,')=',nlon(j),' is invalid.' - write(6,*)'Must be between 1 and ',plon - call endrun - end if - end do - - call wrap_inq_varid (gridid, 'lat', latid) - call wrap_get_var8 (gridid, latid, mlatcnts) - - if (nf_inq_varid (gridid, 'lon', lonid) == nf_noerr) then - call wrap_get_var8 (gridid, lonid, mloncnts(1,1)) - do j=2,nlat - mloncnts(:,j) = mloncnts(:,1) - end do - else - call wrap_inq_varid (gridid, 'rlon', rlonid) - call wrap_get_var8 (gridid, rlonid, mloncnts) - end if - -! Close the grid file - if (nf_close (gridid) == nf_noerr) then - write(6,*) 'close grid file ', trim(gridfile) - else - write(6,*) 'ERROR CLOSING NETCDF FILE ',trim(gridfile) - end if -! -! Allocate space for variables -! - allocate (sgh(plon,nlat)) - allocate (sgh30(plon,nlat)) - allocate (phis(plon,nlat)) - allocate (fland(plon,nlat)) - allocate (landm(plon,nlat)) -! -! Determine model topographic height and 2 standard deviations -! - call sghphis (plon, nlat, nlon, mlatcnts, mloncnts, topofile, & - verbose, sgh, sgh30, have_sgh30, phis, fland) - -! Do the terrain filter. -! Note: not valid if a reduced grid is used. - if (filter_remap) then - z_filter_type = 'remap' - write(6,*)'Remapping terrain filtering' -! 7 and 3 are the recommended mapping accuracy settings - call map2f (plon, nlat, phis, 7, 3, .true.) - if (filter_sgh) then - s_filter_type = 'remap' - write(6,*)'Filtering standard deviation' - call map2f (plon, nlat, sgh, 7, 3, .true.) - if(have_sgh30) call map2f(plon, nlat, sgh30, 7, 3, .true.) - else - s_filter_type = 'none (2x[1-2-1])' - write(6,*)'Not filtering standard deviation' - end if - else if (filter_del2) then - z_filter_type = 'del2' - write(6,*) 'Del2 Terrain filtering' - call sm2(plon, nlat, phis, plon/12, filter_coefficient) - if (filter_sgh) then - s_filter_type = 'del2' - write(6,*)'Filtering standard deviation' - call sm2(plon, nlat, sgh, plon/12, filter_coefficient) - if(have_sgh30) call sm2(plon, nlat, sgh30, plon/12, filter_coefficient) - else - s_filter_type = 'none (2x[1-2-1])' - write(6,*)'Not filtering standard deviation' - end if - else - z_filter_type = 'none' - s_filter_type = 'none (2x[1-2-1])' - endif -! -! Adjustments to land fraction: -! 1. Extend land fraction for Ross Ice shelf -! 2. Set land fractions < .001 to 0.0 -! 3. flag regions outside reduced grid -! - do j=1,nlat - do i=1,nlon(j) -! -! Overwrite FLAND flag as land for Ross ice shelf - if (make_ross .and. mlatcnts(j) < -79.) then - fland(i,j) = 1. - end if - - if (fland(i,j) < .001_r8) fland(i,j) = 0.0 - - end do -! -! Fill region outside reduced grid with flag values - do i=nlon(j)+1,plon - sgh(i,j) = fillvalue - if(have_sgh30) sgh30(i,j) = fillvalue - phis(i,j) = fillvalue - fland(i,j) = fillvalue - landm(i,j) = fillvalue - end do - end do -! -! Calculate LANDM field required by cloud water. -! -!JR Replace original resolution-dependent calculation with interpolation. -!JR -!JR call inimland (plon, nlat, nlon, mlatcnts, mloncnts, topofile, & -!JR verbose, make_ross, landm) -! - call interplandm (plon, nlat, nlon, mlatcnts, mloncnts, & - landmfile, landm) - -! Create NetCDF file for output - ret = nf_create (outbcfile, NF_CLOBBER, foutid) - if (ret .ne. NF_NOERR) call handle_error(ret) - -! Create dimensions for output - call wrap_def_dim (foutid, 'lon', plon, lonid) - call wrap_def_dim (foutid, 'lat', nlat, latid) - dim(1)=lonid - dim(2)=latid - -! Create latitude dimension variable for output - ret = nf_def_var (foutid,'lat', NF_DOUBLE, 1, latid, latdimid) - if (ret .ne. NF_NOERR) call handle_error(ret) - call wrap_put_att_text (foutid,latdimid,'long_name', 'latitude') - call wrap_put_att_text (foutid,latdimid,'units' , 'degrees_north') - -! Create longitude dimension variable for output - if (.not.reduced_grid) then - ret = nf_def_var (foutid,'lon', NF_DOUBLE, 1, lonid, londimid) - if (ret .ne. NF_NOERR) call handle_error(ret) - call wrap_put_att_text (foutid,londimid,'long_name', 'longitude') - call wrap_put_att_text (foutid,londimid,'units' , 'degrees_east') - -! For reduced grid, add longitude limits (nlon) and lons (rlon) - else - ret = nf_def_var (foutid,'nlon', NF_INT, 1, lonid, londimid) - if (ret .ne. NF_NOERR) call handle_error(ret) - ret = nf_def_var (foutid,'rlon', NF_DOUBLE, 2, dim, rlonid) - if (ret .ne. NF_NOERR) call handle_error(ret) - call wrap_put_att_text (foutid,rlonid,'long_name', 'longitude') - call wrap_put_att_text (foutid,rlonid,'units' , 'degrees_east') - end if - -! Create variables for output - ret = nf_def_var (foutid,'PHIS' , NF_DOUBLE, 2, dim, phisid) - if (ret .ne. NF_NOERR) call handle_error(ret) - call wrap_put_att_double (foutid, phisid, '_FillValue', nf_double, 1, fillvalue) - call wrap_put_att_double (foutid, phisid, 'missing_value', nf_double, 1, fillvalue) - call wrap_put_att_text (foutid, phisid, 'long_name' , 'surface geopotential') - call wrap_put_att_text (foutid, phisid, 'units' , 'm2/s2') - call wrap_put_att_text (foutid, phisid, 'from_hires', 'true') - call wrap_put_att_text (foutid, phisid, 'filter' , z_filter_type) - - ret = nf_def_var (foutid,'SGH' , NF_DOUBLE, 2, dim, sghid) - if (ret .ne. NF_NOERR) call handle_error(ret) - call wrap_put_att_double (foutid, sghid, '_FillValue', nf_double, 1, fillvalue) - call wrap_put_att_double (foutid, sghid, 'missing_value', nf_double, 1, fillvalue) - call wrap_put_att_text (foutid, sghid, 'long_name' , 'standard deviation of 10-min elevations') - call wrap_put_att_text (foutid, sghid, 'units' , 'm') - call wrap_put_att_text (foutid, sghid, 'from_hires', 'true') - call wrap_put_att_text (foutid, sghid, 'filter' , s_filter_type) - - if (have_sgh30) then - ret = nf_def_var (foutid,'SGH30' , NF_DOUBLE, 2, dim, sgh30id) - if (ret .ne. NF_NOERR) call handle_error(ret) - call wrap_put_att_double (foutid, sgh30id, '_FillValue', nf_double, 1, fillvalue) - call wrap_put_att_double (foutid, sgh30id, 'missing_value', nf_double, 1, fillvalue) - call wrap_put_att_text (foutid, sgh30id, 'long_name' , 'standard deviation of elevation from 30s to 10m') - call wrap_put_att_text (foutid, sgh30id, 'units' , 'm') - call wrap_put_att_text (foutid, sgh30id, 'from_hires', 'true') - call wrap_put_att_text (foutid, sgh30id, 'filter' , s_filter_type) - endif - - ret = nf_def_var (foutid,'LANDFRAC' , NF_DOUBLE, 2, dim, landfid) - if (ret .ne. NF_NOERR) call handle_error(ret) - call wrap_put_att_double (foutid, landfid, '_FillValue', nf_double, 1, fillvalue) - call wrap_put_att_double (foutid, landfid, 'missing_value', nf_double, 1, fillvalue) - call wrap_put_att_text (foutid, landfid, 'long_name' , 'gridbox land fraction') - call wrap_put_att_text (foutid, landfid, 'from_hires', 'true') - - ret = nf_def_var (foutid,'LANDM_COSLAT', NF_DOUBLE, 2, dim, landmid) - if (ret .ne. NF_NOERR) call handle_error(ret) - call wrap_put_att_double (foutid, landmid, '_FillValue', nf_double, 1, fillvalue) - call wrap_put_att_double (foutid, landmid, 'missing_value', nf_double, 1, fillvalue) - call wrap_put_att_text (foutid, landmid, 'long_name' , & - 'land ocean transition mask: ocean (0), continent (1), transition (0-1)') - call wrap_put_att_text (foutid, landmid, 'from_hires', 'true') - -! Define history attribute. - call DATE_AND_TIME(DATE=datestring) - history = 'Written on date: ' // datestring // cmdline - call wrap_put_att_text (foutid, nf_global, 'history', history) - -! Define Ross Sea attribute - if (make_ross) then - write (6,*) 'Extending Ross ice shelf south of -79 degrees' - call wrap_put_att_text (foutid, nf_global, 'make_ross', 'true') - else - write (6,*) 'Not doing anything special for Ross ice shelf' - call wrap_put_att_text (foutid, nf_global, 'make_ross', 'false') - end if - -! Define source file attributes - call wrap_put_att_text (foutid, nf_global, 'topofile', topofile) - cmdlen = len_trim (gridfile) - call wrap_put_att_text (foutid, nf_global, 'gridfile', gridfile) - cmdlen = len_trim (landmfile) - call wrap_put_att_text (foutid, nf_global, 'landmask', landmfile) - - -! End definition of netCDF file - ret = nf_enddef (foutid) - if (ret/=NF_NOERR) call handle_error (ret) - - -! Write data to file - write(6,*) 'Writing surface quantities' - -! Write dimension variables - call wrap_put_var8 (foutid, latdimid, mlatcnts) - if (.not.reduced_grid) then - call wrap_put_var8 (foutid, londimid, mloncnts(:,1)) - else - ret = nf_put_var_int (foutid, nlonid, nlon) - if (ret/=NF_NOERR) call handle_error (ret) - call wrap_put_vara8 (foutid, rlonid, start, count, mloncnts) - end if - - start(:) = 1 - count(1) = plon - count(2) = nlat - count(3:) = 1 - - call wrap_put_vara8 (foutid, sghid, start, count, sgh) - if(have_sgh30) call wrap_put_vara8 (foutid, sgh30id, start, count, sgh30) - call wrap_put_vara8 (foutid, phisid , start, count, phis) - call wrap_put_vara8 (foutid, landfid, start, count, fland) - call wrap_put_vara8 (foutid, landmid, start, count, landm) - - if (nf_close (foutid) == nf_noerr) then - write(6,*) 'Successfully defined surface quantities on ', trim(outbcfile) - else - write(6,*) 'ERROR CLOSING NETCDF FILE ',trim(outbcfile) - end if - - deallocate (nlon) - deallocate (mlatcnts) - deallocate (mloncnts) - deallocate (sgh) - deallocate (sgh30) - deallocate (phis) - deallocate (fland) - deallocate (landm) - - stop 0 -end program fmain - -subroutine usage_exit (arg) - implicit none - character*(*) arg - - if (arg /= ' ') write (6,*) arg - write (6,*) 'Usage: definesurf -t topofile -g gridfile -l landmfile [-v] [-r] [-del2] [-remap] outfile' - write (6,*) ' -v verbose mode' - write (6,*) ' -r Do *not* extend Ross Ice Shelf as land ice' - write (6,*) ' -del2 use del2 terrain filter (not a valid option for reduced grid)' - write (6,*) ' -remap use remapping filter (not a valid option for reduced grid)' - write (6,*) ' -sgh filter sgh and sgh30 using same terrain filter' - stop 999 -end subroutine usage_exit diff --git a/tools/definesurf/handle_error.f90 b/tools/definesurf/handle_error.f90 deleted file mode 100644 index 519f829097..0000000000 --- a/tools/definesurf/handle_error.f90 +++ /dev/null @@ -1,11 +0,0 @@ -subroutine handle_error (ret) - implicit none - - integer ret - - include 'netcdf.inc' - - write(6,*) nf_strerror (ret) - call abort - stop 999 -end subroutine handle_error diff --git a/tools/definesurf/inimland.f90 b/tools/definesurf/inimland.f90 deleted file mode 100644 index af929f1b98..0000000000 --- a/tools/definesurf/inimland.f90 +++ /dev/null @@ -1,205 +0,0 @@ -subroutine inimland (plon, nlat, nlon_reduced, mlatcnts, mloncnts, topofile, & - verbose, make_ross, landm_reduced) - use shr_kind_mod, only: r8 => shr_kind_r8 - - implicit none -! -! Input arguments -! - integer , intent(in) :: plon ! number of longitudes - integer , intent(in) :: nlat ! number of latitudes - integer , intent(in) :: nlon_reduced(nlat) ! number of reduced latitudes - real(r8), intent(in) :: mlatcnts(nlat) ! latitude at center of grid cell - real(r8), intent(in) :: mloncnts(plon,nlat) ! model cell ceneter longitudes - character(len=*), intent(in) :: topofile ! high res topo file - logical, intent(in) :: verbose ! verbose output - logical, intent(in) :: make_ross ! flag to make Ross ice shelf -! -! Output arguments -! - real(r8), intent(out) :: landm_reduced(plon,nlat) ! landm on reduced grid - -! Local variables - - real(r8) landm(plon,nlat) ! landm on full grid - real(r8) clon(plon) - real(r8) clon_reduced(plon,nlat) - real(r8) cont(plon,nlat) - real(r8) temp(plon,nlat) - real(r8) dmax - real(r8) arad - real(r8) dist - real(r8) sum - real(r8) cs(nlat) - real(r8) ss(nlat) - real(r8) c1 - real(r8) s1 - real(r8) c2 - real(r8) s2 - real(r8) dx - real(r8) dy - real(r8) term - real(r8) pi - real(r8) sgh(plon,nlat) ! required by SGHPHIS (unused locally) - real(r8) phis(plon,nlat) ! required by SGHPHIS (unused locally) - real(r8) oro(plon,nlat) ! land/ocean flag - real(r8) fland(plon,nlat) ! land fraction output from SGHPHIS - real(r8) mloncnts_full(plon,nlat) ! longitudes for rectangular grid - - integer i - integer j - integer ii - integer jj - integer iplm1 - integer jof - integer iof - integer itmp - integer jmin, jmax - integer nlon(nlat) - integer latid - - pi = acos(-1.d0) -! -! Define longitudes for a rectangular grid: index nlat/2+1 will be a latitude -! closest to the equator, i.e. with the most points in a reduced grid. -! - nlon(:) = plon - do j=1,nlat - mloncnts_full(:,j) = mloncnts(:,nlat/2+1) - end do - - call sghphis (plon, nlat, nlon, mlatcnts, mloncnts_full, topofile, & - verbose, sgh, phis, fland) -! -! Define land mask. Set all non-land points to ocean (i.e. not sea ice). -! - where (fland(:,:) >= 0.5) - oro(:,:) = 1. - elsewhere - oro(:,:) = 0. - endwhere -! -! Overwrite ORO flag as land for Ross ice shelf: note that the ORO field -! defined in this routine is only used locally. -! - do j=1,nlat - if (make_ross .and. mlatcnts(j) < -79.) then - do i=1,plon - oro(i,j) = 1. - end do - end if - end do -! -! Code lifted directly from cldwat.F -! - dmax = 2.e6 ! distance to carry the mask - arad = 6.37e6 - do i = 1,plon - clon(i) = 2.*(i-1)*pi/plon - end do -! -! first isolate the contenents -! as land points not surrounded by ocean or ice -! - do j = 1,nlat - cs(j) = cos(mlatcnts(j)*pi/180.) - ss(J) = sin(mlatcnts(j)*pi/180.) - do i = 1,plon - cont(i,j) = 0. - if (nint(oro(i,j)) .eq. 1) then - cont(i,j) = 1. - endif - end do - temp(1,j) = cont(1,j) - temp(plon,j) = cont(plon,j) - end do - - do i = 1,plon - temp(i,1) = cont(i,1) - temp(i,nlat) = cont(i,nlat) - end do -! -! get rid of one and two point islands -! - do j = 2,nlat-1 - do i = 2,plon-1 - sum = cont(i ,j+1) + cont(i ,j-1) & - + cont(i+1,j+1) + cont(i+1,j-1) & - + cont(i-1,j+1) + cont(i-1,j-1) & - + cont(i+1,j ) + cont(i-1,j) & - + cont(i ,j ) - if (sum.le.2.) then - temp(i,j) = 0. - else - temp(i,j) = 1. - endif - enddo - end do - - do j = 1,nlat - do i = 1,plon - cont(i,j) = temp(i,j) - end do - end do -! -! construct a function which is one over land, -! zero over ocean points beyond dmax from land -! - iplm1 = 2*plon - 1 - dy = pi*arad/nlat - jof = dmax/dy + 1 -! write (6,*) ' lat bands to check ', 2*jof+1 - do j = 1,nlat - c1 = cs(j) - s1 = ss(j) - dx = 2*pi*arad*cs(j)/plon -! -! if dx is too small, int(dmax/dx) may exceed the maximum size -! of an integer, especially on Suns, causing a core dump. Test -! to avoid that. -! - if (dx .lt. 1. .and. dmax .gt. 10000.) then - iof = plon - else - iof = min(int(dmax/dx) + 1, plon) - end if - do i = 1,plon - temp(i,j) = 0. - landm(i,j) = 0. - jmin = max(1,j-jof) - jmax = min(nlat,j+jof) - do jj = jmin, jmax - s2 = ss(jj) - c2 = cs(jj) - do itmp = -iof,iof - ii = mod(i+itmp+iplm1,plon)+1 - term = s1*s2 + c1*c2*cos(clon(ii)-clon(i)) - if (term.gt.0.9999999) term = 1. - dist = arad*acos(term) - landm(i,j) = max(landm(i,j), (1.-dist/dmax)*cont(ii,jj)) -! if (dist.lt.dmax .and. cont(ii,jj).eq.1) then -! landm(i,j) = max(landm(i,j), 1.-dist/dmax) -! endif - end do - end do - end do - end do -! -! Interpolate to reduced grid. Redefine clon in terms of degrees for interpolation -! - do i = 1,plon - clon(i) = (i-1)*360./plon - end do - do j=1,nlat - do i=1,nlon_reduced(j) - clon_reduced(i,j) = (i-1)*360./nlon_reduced(j) - end do - end do - - do j=1,nlat - call lininterp (landm(1,j), plon, 1, clon, & - landm_reduced(1,j), nlon_reduced(j), 1, clon_reduced(1,j), .true.) - end do - - return - end diff --git a/tools/definesurf/interplandm.f90 b/tools/definesurf/interplandm.f90 deleted file mode 100644 index 88e5fd3d17..0000000000 --- a/tools/definesurf/interplandm.f90 +++ /dev/null @@ -1,92 +0,0 @@ -subroutine interplandm (plono, nlato, nlono, lato, rlono, & - landmfile, landmo) -! -! Read LANDM_COSLAT from input file and interpolate to output grid. -! The input grid is assumed rectangular, but the output grid may -! be reduced. -! - use shr_kind_mod, only: r8 => shr_kind_r8 - - implicit none - - include 'netcdf.inc' -! -! Input arguments -! - integer , intent(in) :: plono ! output longitude dimension - integer , intent(in) :: nlato ! number of latitudes - integer , intent(in) :: nlono(nlato) ! number of reduced latitudes - real(r8), intent(in) :: lato(nlato) ! latitude at center of grid cell - real(r8), intent(in) :: rlono(plono,nlato) ! longitude on (potentially reduced) output grid - character(len=*), intent(in) :: landmfile ! file containing input LANDM_COSLAT -! -! Output arguments -! - real(r8), intent(out) :: landmo(plono,nlato) ! landm on reduced grid - -! Local variables - - integer :: nloni - integer :: nlati - integer :: i,j ! spatial indices - integer :: ret ! return code - - integer :: landmfileid ! netcdf file id for landm file - integer :: londimid, latdimid ! lon, lat dimension ids - integer :: lonid, latid ! lon, lat var ids - integer :: landmid ! landm variable id - - real(r8), allocatable :: landmi(:,:) ! landm on full grid - real(r8), allocatable :: lati(:) - real(r8), allocatable :: loni(:) - real(r8), allocatable :: xtemp(:,:) ! temporary for interpolation - - ret = nf_open (landmfile, nf_nowrite, landmfileid) - if (ret /= nf_noerr) then - write(6,*)nf_strerror(ret) - write(6,*)'Unable to open input file ', trim (landmfile) - stop 999 - end if -! -! Retrieve grid info and LANDM_COSLAT field from from offline file. -! - call wrap_inq_dimid (landmfileid, 'lat', latdimid) - call wrap_inq_dimlen (landmfileid, latdimid, nlati) - - call wrap_inq_dimid (landmfileid, 'lon', londimid) - call wrap_inq_dimlen (landmfileid, londimid, nloni) - - allocate (lati(nlati)) - allocate (loni(nloni)) - allocate (landmi(nloni,nlati)) - - call wrap_inq_varid (landmfileid, 'lat', latid) - call wrap_get_var8 (landmfileid, latid, lati) - - call wrap_inq_varid (landmfileid, 'lon', lonid) - call wrap_get_var8 (landmfileid, lonid, loni) - - call wrap_inq_varid (landmfileid, 'LANDM_COSLAT', landmid) - call wrap_get_var8 (landmfileid, landmid, landmi) - - allocate (xtemp(nloni,nlato)) -! -! For rectangular -> reduced, interpolate first in latitude, then longitude -! - do i=1,nloni - call lininterp (landmi(i,1), nlati, nloni, lati, & - xtemp(i,1), nlato, nloni, lato, .false.) - end do - - do j=1,nlato - call lininterp (xtemp(1,j), nloni, 1, loni, & - landmo(1,j), nlono(j), 1, rlono(1,j), .true.) - end do - - deallocate (xtemp) - deallocate (lati) - deallocate (loni) - deallocate (landmi) - - return -end subroutine interplandm diff --git a/tools/definesurf/lininterp.f90 b/tools/definesurf/lininterp.f90 deleted file mode 100644 index 9d5d9d9e76..0000000000 --- a/tools/definesurf/lininterp.f90 +++ /dev/null @@ -1,174 +0,0 @@ -subroutine lininterp (arrin, nxin, incin, xin, & - arrout, nxout, incout, xout, periodic) - use shr_kind_mod, only: r8 => shr_kind_r8 - -!----------------------------------------------------------------------- -! -! Do a linear interpolation from input mesh defined by xin to output -! mesh defined by xout. Where extrapolation is necessary, values will -! be copied from the extreme edge of the input grid. -! -!---------------------------Code history-------------------------------- -! -! Original version: J. Rosinski -! -!----------------------------------------------------------------------- - implicit none -!----------------------------------------------------------------------- -! -! Arguments -! - integer nxin, incin - integer nxout, incout - - real(r8) xin(nxin), xout(nxout) - real(r8) arrin(incin,nxin) - real(r8) arrout(incout,nxout) - - logical periodic -! -! Local workspace -! - integer i, ii ! input grid indices - integer im, ip, iiprev ! input grid indices - integer icount ! number of values - - real(r8) extrap ! percent grid non-overlap - real(r8) dxinwrap ! delta-x on input grid for 2-pi - real(r8) avgdxin ! avg input delta-x - real(r8) ratio ! compare dxinwrap to avgdxin -! -! Dynamic -! - integer iim(nxout) ! interp. indices minus - integer iip(nxout) ! interp. indices plus - - real(r8) wgtm(nxout) ! interp. weight minus - real(r8) wgtp(nxout) ! interp. weight plus -! -! Just copy the data and return if input dimensions are 1 -! - if (nxin.eq.1 .and. nxout.eq.1) then - arrout(1,1) = arrin(1,1) - else if (nxin.eq.1) then - write(6,*)'LININTERP: Must have at least 2 input points' - call abort - end if - icount = 0 - do i=1,nxin-1 - if (xin(i).gt.xin(i+1)) icount = icount + 1 - end do - do i=1,nxout-1 - if (xout(i).gt.xout(i+1)) icount = icount + 1 - end do - if (icount.gt.0) then - write(6,*)'LININTERP: Non-monotonic coordinate array(s) found' - call abort - end if -! -! Initialize index arrays for later checking -! - do i=1,nxout - iim(i) = 0 - iip(i) = 0 - end do - if (periodic) then -! -! Periodic case: for values which extend beyond boundaries, assume -! periodicity and interpolate between endpoints. First check for sane -! periodicity assumption. -! - if (xin(1).lt.0. .or. xin(nxin).gt.360.) then - write(6,*)'LININTERP: For periodic Input x-grid must be between 0 and 360' - call abort - end if - if (xout(1).lt.0. .or. xout(nxout).gt.360.) then - write(6,*)'Output x-grid must be between 0 and 360' - call abort - end if - dxinwrap = xin(1) + 360. - xin(nxin) - avgdxin = (xin(nxin)-xin(1))/(nxin-1.) - ratio = dxinwrap/avgdxin - if (ratio.lt.0.9 .or. ratio.gt.1.1) then - write(6,*)'LININTERP: Insane dxinwrap value =',dxinwrap,' avg=', avgdxin - call abort - end if - do im=1,nxout - if (xout(im).gt.xin(1)) exit - iim(im) = nxin - iip(im) = 1 - wgtm(im) = (xin(1) - xout(im)) /dxinwrap - wgtp(im) = (xout(im)+360. - xin(nxin))/dxinwrap - end do - do ip=nxout,1,-1 - if (xout(ip).le.xin(nxin)) exit - iim(ip) = nxin - iip(ip) = 1 - wgtm(ip) = (xin(1)+360. - xout(ip)) /dxinwrap - wgtp(ip) = (xout(ip) - xin(nxin))/dxinwrap - end do - else -! -! Non-periodic case: for values which extend beyond boundaries, set weights -! such that values will just be copied. -! - do im=1,nxout - if (xout(im).gt.xin(1)) exit - iim(im) = 1 - iip(im) = 1 - wgtm(im) = 1. - wgtp(im) = 0. - end do - do ip=nxout,1,-1 - if (xout(ip).le.xin(nxin)) exit - iim(ip) = nxin - iip(ip) = nxin - wgtm(ip) = 1. - wgtp(ip) = 0. - end do - end if -! -! Loop though output indices finding input indices and weights -! - iiprev = 1 - do i=im,ip - do ii=iiprev,nxin-1 - if (xout(i).gt.xin(ii) .and. xout(i).le.xin(ii+1)) then - iim(i) = ii - iip(i) = ii + 1 - wgtm(i) = (xin(ii+1)-xout(i))/(xin(ii+1)-xin(ii)) - wgtp(i) = (xout(i)-xin(ii))/(xin(ii+1)-xin(ii)) - goto 30 - end if - end do - write(6,*)'LININTERP: Failed to find interp values' -30 iiprev = ii - end do -! -! Check grid overlap -! - extrap = 100.*((im - 1.) + (nxout - ip))/nxout - if (extrap.gt.30.) then - write(6,*)'********LININTERP WARNING:',extrap,' % of output', & - ' grid will have to be extrapolated********' - end if -! -! Check that interp/extrap points have been found for all outputs -! - icount = 0 - do i=1,nxout - if (iim(i).eq.0 .or. iip(i).eq.0) icount = icount + 1 - end do - if (icount.gt.0) then - write(6,*)'LININTERP: Point found without interp indices' - call abort - end if -! -! Do the interpolation -! - do i=1,nxout - arrout(1,i) = arrin(1,iim(i))*wgtm(i) + arrin(1,iip(i))*wgtp(i) - end do - return -end subroutine lininterp - diff --git a/tools/definesurf/map2f.f90 b/tools/definesurf/map2f.f90 deleted file mode 100644 index 1fb58b3f8a..0000000000 --- a/tools/definesurf/map2f.f90 +++ /dev/null @@ -1,1039 +0,0 @@ - subroutine map2f(im, jm, qm, iord, jord, pfilter) -! -! This is a stand alone 2-Grid-Wave filter for filtering the terrain for -! the finite-volume dynamical core -! Developed and coded by S.-J. Lin -! Data Assimilation Office, NASA/GSFC -! - implicit none -! Input - integer, intent(in):: im ! E-W diimension (e.g., 144 for 2.5 deg) - integer, intent(in):: jm ! N-S dimension (S pole to N pole; 91 for 2 deg) - integer, intent(in):: iord ! Mapping accuracy for E-W; recommended value=7 - integer, intent(in):: jord ! Mapping accuracy for N-S; recommended value=3 - logical, intent(in):: pfilter ! Polar filter (set to .T. for normal application) - -! Input/Output - real*8, intent(inout):: qm(im,jm) ! array to be filtered - -! Local - integer im2, jm2 - integer ndeg - real*8, allocatable:: q2(:,:) - real*8, allocatable:: lon1(:) - real*8, allocatable:: lon2(:) - real*8, allocatable:: sin1(:) - real*8, allocatable:: sin2(:) - real*8, allocatable:: qt1(:,:), qt2(:,:) - - real*8 dx1, dx2 - real*8 dy1, dy2 - - integer i, j - real*8 pi - - ndeg = 45 ! starting latitude for polar filter - pi = 4.d0 * datan(1.d0) - - im2 = im / 2 - if (im2*2 /= im) then - write(*,*) 'Stop in map2f; im=', im - stop - endif - - jm2 = (jm-1) / 2 + 1 - - allocate ( qt1(im2,jm) ) - allocate ( qt2(im2,jm2) ) - - allocate ( q2(im2,jm2) ) - allocate ( lon1(im+1) ) - allocate ( lon2(im2+1) ) - allocate ( sin1(jm+1) ) - allocate ( sin2(jm2+1) ) - - dx1 = 360./im - dx2 = 360./im2 - - dy1 = pi/(jm-1) - dy2 = pi/(jm2-1) - - do i=1,im+1 - lon1(i) = dx1 * (-0.5 + (i-1) ) - enddo - - do i=1,im2+1 - lon2(i) = dx2 * (-0.5 + (i-1) ) - enddo - - sin1(1) = -1. - sin2(1) = -1. - - sin1(jm +1) = 1. - sin2(jm2+1) = 1. - - do j=2,jm - sin1(j) = dsin( -0.5*pi + dy1*(-0.5+(j-1)) ) - enddo - - do j=2,jm2 - sin2(j) = dsin( -0.5*pi + dy2*(-0.5+(j-1)) ) - enddo - - call polavg(qm, im, jm, 1, jm) - if( pfilter ) call plft2d(im, jm, qm, 2, jm-1, ndeg) - -!============================== -! From full --> half resolution -!============================== - - call xmap(iord, im, jm, sin1, lon1, qm, im2, lon2, qt1 ) - call ymap(im2, jm, sin1, qt1, jm2, sin2, qt2, 0, jord) - -!============================== -! From half --> full resolution -!============================== - - call ymap(im2, jm2, sin2, qt2, jm, sin1, qt1, 0, jord) - call xmap(iord, im2, jm, sin1, lon2, qt1, im, lon1, qm ) - -! Apply Monotonicity preserving polar filter - if( pfilter ) call plft2d(im, jm, qm, 2, jm-1, ndeg) - call polavg(qm, im, jm, 1, jm) - - deallocate ( q2 ) - deallocate ( lon1 ) - deallocate ( lon2 ) - deallocate ( sin1 ) - deallocate ( sin2 ) - - deallocate ( qt1 ) - deallocate ( qt2 ) - - return - end - - subroutine polavg(p, im, jm, jfirst, jlast) - - implicit none - - integer im, jm, jfirst, jlast - real*8 p(im,jfirst:jlast) - real*8 sum1 - integer i - - if ( jfirst == 1 ) then - sum1 = 0. - do i=1,im - sum1 = sum1 + p(i,1) - enddo - sum1 = sum1/im - - do i=1,im - p(i,1) = sum1 - enddo - endif - - if ( jlast == jm ) then - sum1 = 0. - do i=1,im - sum1 = sum1 + p(i,jm) - enddo - sum1 = sum1/im - - do i=1,im - p(i,jm) = sum1 - enddo - endif - - return - end - - subroutine setrig(im, jm, dp, dl, cosp, cose, sinp, sine) - - implicit none - - integer im, jm - integer j, jm1 - real*8 sine(jm),cosp(jm),sinp(jm),cose(jm) - real*8 dp, dl - real*8 pi, ph5 - - jm1 = jm - 1 - pi = 4.d0 * datan(1.d0) - dl = (pi+pi)/dble(im) - dp = pi/dble(jm1) - - do 10 j=2,jm - ph5 = -0.5d0*pi + (dble(j-1)-0.5d0)*(pi/dble(jm1)) -10 sine(j) = dsin(ph5) - - cosp( 1) = 0. - cosp(jm) = 0. - - do 80 j=2,jm1 -80 cosp(j) = (sine(j+1)-sine(j)) / dp - -! Define cosine at edges.. - - do 90 j=2,jm -90 cose(j) = 0.5 * (cosp(j-1) + cosp(j)) - cose(1) = cose(2) - - sinp( 1) = -1. - sinp(jm) = 1. - - do 100 j=2,jm1 -100 sinp(j) = 0.5 * (sine(j) + sine(j+1)) - - return - end - - subroutine ymap(im, jm, sin1, q1, jn, sin2, q2, iv, jord) - -! Routine to perform area preserving mapping in N-S from an arbitrary -! resolution to another. -! -! sin1 (1) = -1 must be south pole; sin1(jm+1)=1 must be N pole. -! -! sin1(1) < sin1(2) < sin1(3) < ... < sin1(jm) < sin1(jm+1) -! sin2(1) < sin2(2) < sin2(3) < ... < sin2(jn) < sin2(jn+1) -! -! Developer: S.-J. Lin -! First version: piece-wise constant mapping -! Apr 1, 2000 -! Last modified: - - implicit none - -! Input - integer im ! original E-W dimension - integer jm ! original N-S dimension - integer jn ! Target N-S dimension - integer jord - integer iv ! iv=0 scalar; iv=1: vector - real*8 sin1(jm+1) ! original southern edge of the cell - ! sin(lat1) - real*8 sin2(jn+1) ! Target cell's southern edge - real*8 q1(im,jm) ! original data at center of the cell - ! sin(lat2) -! Output - real*8 q2(im,jn) ! Mapped data at the target resolution - -! Local - integer i, j0, m, mm - integer j - -! PPM related arrays - real*8 al(im,jm) - real*8 ar(im,jm) - real*8 a6(im,jm) - real*8 dy1(jm) - - real*8 r3, r23 - parameter ( r3 = 1./3., r23 = 2./3. ) - real*8 pl, pr, qsum, esl - real*8 dy, sum - - do j=1,jm - dy1(j) = sin1(j+1) - sin1(j) - enddo - -! *********************** -! Area preserving mapping -! *********************** - -! Construct subgrid PP distribution - if ( jord == 1 ) then - - do j=1,jm - do i=1,im - a6(i,j) = 0. - ar(i,j) = q1(i,j) - al(i,j) = q1(i,j) - enddo - enddo - - else - - call ppm_lat(im, jm, q1, al, ar, a6, jord, iv) - do i=1,im -! SP - a6(i, 1) = 0. - ar(i, 1) = q1(i,1) - al(i, 1) = q1(i,1) -! NP - a6(i,jm) = 0. - ar(i,jm) = q1(i,jm) - al(i,jm) = q1(i,jm) - enddo - endif - - do 1000 i=1,im - j0 = 1 - do 555 j=1,jn - do 100 m=j0,jm -! -! locate the southern edge: sin2(i) -! - if(sin2(j) .ge. sin1(m) .and. sin2(j) .le. sin1(m+1)) then - pl = (sin2(j)-sin1(m)) / dy1(m) - if(sin2(j+1) .le. sin1(m+1)) then -! entire new cell is within the original cell - pr = (sin2(j+1)-sin1(m)) / dy1(m) - q2(i,j) = al(i,m) + 0.5*(a6(i,m)+ar(i,m)-al(i,m)) & - *(pr+pl)-a6(i,m)*r3*(pr*(pr+pl)+pl**2) - j0 = m - goto 555 - else -! South most fractional area - qsum = (sin1(m+1)-sin2(j))*(al(i,m)+0.5*(a6(i,m)+ & - ar(i,m)-al(i,m))*(1.+pl)-a6(i,m)* & - (r3*(1.+pl*(1.+pl)))) - do mm=m+1,jm -! locate the eastern edge: sin2(j+1) - if(sin2(j+1) .gt. sin1(mm+1) ) then -! Whole layer - qsum = qsum + dy1(mm)*q1(i,mm) - else -! North most fractional area - dy = sin2(j+1)-sin1(mm) - esl = dy / dy1(mm) - qsum = qsum + dy*(al(i,mm)+0.5*esl* & - (ar(i,mm)-al(i,mm)+a6(i,mm)*(1.-r23*esl))) - j0 = mm - goto 123 - endif - enddo - goto 123 - endif - endif -100 continue -123 q2(i,j) = qsum / ( sin2(j+1) - sin2(j) ) -555 continue -1000 continue - -! Final processing for poles - - if ( iv == 0 ) then - -! South pole - sum = 0. - do i=1,im - sum = sum + q2(i,1) - enddo - - sum = sum / im - do i=1,im - q2(i,1) = sum - enddo - -! North pole: - sum = 0. - do i=1,im - sum = sum + q2(i,jn) - enddo - - sum = sum / im - do i=1,im - q2(i,jn) = sum - enddo - - endif - - return - end - - subroutine ppm_lat(im, jm, q, al, ar, a6, jord, iv) - implicit none - -!INPUT - integer im, jm ! Dimensions - real*8 q(im,jm) - real*8 al(im,jm) - real*8 ar(im,jm) - real*8 a6(im,jm) - integer jord - integer iv ! iv=0 scalar - ! iv=1 vector -! Local - real*8 dm(im,jm) - real*8 r3 - parameter ( r3 = 1./3. ) - integer i, j, im2, iop, jm1 - real*8 tmp, qmax, qmin - real*8 qop - -! Compute dm: linear slope - - do j=2,jm-1 - do i=1,im - dm(i,j) = 0.25*(q(i,j+1) - q(i,j-1)) - qmax = max(q(i,j-1),q(i,j),q(i,j+1)) - q(i,j) - qmin = q(i,j) - min(q(i,j-1),q(i,j),q(i,j+1)) - dm(i,j) = sign(min(abs(dm(i,j)),qmin,qmax),dm(i,j)) - enddo - enddo - - im2 = im/2 - jm1 = jm - 1 - -!Poles: - if (iv == 1 ) then -! SP - do i=1,im - if( i .le. im2) then - qop = -q(i+im2,2) - else - qop = -q(i-im2,2) - endif - tmp = 0.25*(q(i,2) - qop) - qmax = max(q(i,2),q(i,1), qop) - q(i,1) - qmin = q(i,1) - min(q(i,2),q(i,1), qop) - dm(i,1) = sign(min(abs(tmp),qmax,qmin),tmp) - enddo -! NP - do i=1,im - if( i .le. im2) then - qop = -q(i+im2,jm1) - else - qop = -q(i-im2,jm1) - endif - tmp = 0.25*(qop - q(i,jm1)) - qmax = max(qop,q(i,jm), q(i,jm1)) - q(i,jm) - qmin = q(i,jm) - min(qop,q(i,jm), q(i,jm1)) - dm(i,jm) = sign(min(abs(tmp),qmax,qmin),tmp) - enddo - else -! -!********* -! Scalar: -!********* -! SP - do i=1,im2 - tmp = 0.25*(q(i,2)-q(i+im2,2)) - qmax = max(q(i,2),q(i,1), q(i+im2,2)) - q(i,1) - qmin = q(i,1) - min(q(i,2),q(i,1), q(i+im2,2)) - dm(i,1) = sign(min(abs(tmp),qmax,qmin),tmp) - enddo - - do i=im2+1,im - dm(i, 1) = - dm(i-im2, 1) - enddo -! NP - do i=1,im2 - tmp = 0.25*(q(i+im2,jm1)-q(i,jm1)) - qmax = max(q(i+im2,jm1),q(i,jm), q(i,jm1)) - q(i,jm) - qmin = q(i,jm) - min(q(i+im2,jm1),q(i,jm), q(i,jm1)) - dm(i,jm) = sign(min(abs(tmp),qmax,qmin),tmp) - enddo - - do i=im2+1,im - dm(i,jm) = - dm(i-im2,jm) - enddo - endif - - do j=2,jm - do i=1,im - al(i,j) = 0.5*(q(i,j-1)+q(i,j)) + r3*(dm(i,j-1) - dm(i,j)) - enddo - enddo - - do j=1,jm-1 - do i=1,im - ar(i,j) = al(i,j+1) - enddo - enddo - - do j=2,jm-1 - do i=1,im - a6(i,j) = 3.*(q(i,j)+q(i,j) - (al(i,j)+ar(i,j))) - enddo - - call lmppm(dm(1,j), a6(1,j), ar(1,j), & - al(1,j), q(1,j), im, jord-3) - enddo - - return - end - - subroutine xmap(iord, im, jm, sin1, lon1, q1, in, lon2, q2) - -! Routine to perform area preserving mapping in E-W from an arbitrary -! resolution to another. -! Periodic domain will be assumed, i.e., the eastern wall bounding cell -! im is lon1(im+1) = lon1(1); Note the equal sign is true geographysically. -! -! lon1(1) < lon1(2) < lon1(3) < ... < lon1(im) < lon1(im+1) -! lon2(1) < lon2(2) < lon2(3) < ... < lon2(in) < lon2(in+1) -! -! Developer: S.-J. Lin -! First version: piece-wise constant mapping -! Apr 1, 2000 -! Last modified: - - implicit none - -! Input - integer iord - integer im ! original E-W dimension - integer in ! Target E-W dimension - integer jm ! original N-S dimension - real*8 lon1(im+1) ! original western edge of the cell - real*8 sin1(jm+1) - real*8 q1(im,jm) ! original data at center of the cell - real*8 lon2(in+1) ! Target cell's western edge - -! Output - real*8 q2(in,jm) ! Mapped data at the target resolution - -! Local - integer i1, i2 - integer i, i0, m, mm - integer j - integer ird - -! PPM related arrays - real*8 qtmp(-im:im+im) - real*8 al(-im:im+im) - real*8 ar(-im:im+im) - real*8 a6(-im:im+im) - real*8 x1(-im:im+im+1) - real*8 dx1(-im:im+im) - real*8 r3, r23 - parameter ( r3 = 1./3., r23 = 2./3. ) - real*8 pl, pr, qsum, esl - real*8 dx - logical found - - do i=1,im+1 - x1(i) = lon1(i) - enddo - - do i=1,im - dx1(i) = x1(i+1) - x1(i) - enddo - -! check to see if ghosting is necessary - -!************** -! Western edge: -!************** - found = .false. - i1 = 1 - do while ( .not. found ) - if( lon2(1) .ge. x1(i1) ) then - found = .true. - else - i1 = i1 - 1 - if (i1 .lt. -im) then - write(6,*) 'failed in xmap' - stop - else - x1(i1) = x1(i1+1) - dx1(im+i1) - dx1(i1) = dx1(im+i1) - endif - endif - enddo - -!************** -! Eastern edge: -!************** - found = .false. - i2 = im+1 - do while ( .not. found ) - if( lon2(in+1) .le. x1(i2) ) then - found = .true. - else - i2 = i2 + 1 - if (i2 .gt. 2*im) then - write(6,*) 'failed in xmap' - stop - else - dx1(i2-1) = dx1(i2-1-im) - x1(i2) = x1(i2-1) + dx1(i2-1) - endif - endif - enddo - - do 1000 j=1,jm - -! *********************** -! Area preserving mapping -! *********************** - -! Construct subgrid PP distribution - if ( abs(sin1(j)+sin1(j+1)) > 1.5 ) then - ird = 3 - elseif ( abs(sin1(j)+sin1(j+1)) < 1.0 ) then - ird = 8 - else - ird = iord - endif - - if ( iord == 1 ) then - do i=1,im - qtmp(i) = q1(i,j) - al(i) = q1(i,j) - ar(i) = q1(i,j) - a6(i) = 0. - enddo - qtmp(0 ) = q1(im,j) - qtmp(im+1) = q1(1, j) - else - call ppm_cycle(im, q1(1,j), al(1), ar(1), a6(1), qtmp, ird) - endif - -! check to see if ghosting is necessary - -! Western edge - if ( i1 .le. 0 ) then - do i=i1,0 - qtmp(i) = qtmp(im+i) - al(i) = al(im+i) - ar(i) = ar(im+i) - a6(i) = a6(im+i) - enddo - endif - -! Eastern edge: - if ( i2 .gt. im+1 ) then - do i=im+1,i2-1 - qtmp(i) = qtmp(i-im) - al(i) = al(i-im) - ar(i) = ar(i-im) - a6(i) = a6(i-im) - enddo - endif - - i0 = i1 - - do 555 i=1,in - do 100 m=i0,i2-1 -! -! locate the western edge: lon2(i) -! - if(lon2(i) .ge. x1(m) .and. lon2(i) .le. x1(m+1)) then - pl = (lon2(i)-x1(m)) / dx1(m) - if(lon2(i+1) .le. x1(m+1)) then -! entire new grid is within the original grid - pr = (lon2(i+1)-x1(m)) / dx1(m) - q2(i,j) = al(m) + 0.5*(a6(m)+ar(m)-al(m)) & - *(pr+pl)-a6(m)*r3*(pr*(pr+pl)+pl**2) - i0 = m - goto 555 - else -! Left most fractional area - qsum = (x1(m+1)-lon2(i))*(al(m)+0.5*(a6(m)+ & - ar(m)-al(m))*(1.+pl)-a6(m)* & - (r3*(1.+pl*(1.+pl)))) - do mm=m+1,i2-1 -! locate the eastern edge: lon2(i+1) - if(lon2(i+1) .gt. x1(mm+1) ) then -! Whole layer - qsum = qsum + dx1(mm)*qtmp(mm) - else -! Right most fractional area - dx = lon2(i+1)-x1(mm) - esl = dx / dx1(mm) - qsum = qsum + dx*(al(mm)+0.5*esl* & - (ar(mm)-al(mm)+a6(mm)*(1.-r23*esl))) - i0 = mm - goto 123 - endif - enddo - goto 123 - endif - endif -100 continue -123 q2(i,j) = qsum / ( lon2(i+1) - lon2(i) ) -555 continue -1000 continue - - return - end - - subroutine ppm_cycle(im, q, al, ar, a6, p, iord) - implicit none - - real*8 r3 - parameter ( r3 = 1./3. ) - -! Input - integer im, iord - real*8 q(1) -! Output - real*8 al(1) - real*8 ar(1) - real*8 a6(1) - real*8 p(-im:im+im) - -! local - real*8 dm(0:im) - integer i, lmt - real*8 tmp, qmax, qmin - - p(0) = q(im) - do i=1,im - p(i) = q(i) - enddo - p(im+1) = q(1) - -! 2nd order slope - do i=1,im - tmp = 0.25*(p(i+1) - p(i-1)) - qmax = max(p(i-1), p(i), p(i+1)) - p(i) - qmin = p(i) - min(p(i-1), p(i), p(i+1)) - dm(i) = sign(min(abs(tmp),qmax,qmin), tmp) - enddo - dm(0) = dm(im) - - do i=1,im - al(i) = 0.5*(p(i-1)+p(i)) + (dm(i-1) - dm(i))*r3 - enddo - - do i=1,im-1 - ar(i) = al(i+1) - enddo - ar(im) = al(1) - - do i=1,im - a6(i) = 3.*(p(i)+p(i) - (al(i)+ar(i))) - enddo - - if(iord <= 6) then - lmt = iord - 3 - if(lmt <= 2) call lmppm(dm(1),a6(1),ar(1),al(1),p(1),im,lmt) - else - call huynh(im, ar(1), al(1), p(1), a6(1), dm(1)) - call lmppm(dm(1),a6(1),ar(1),al(1),p(1),im,2) - endif - - return - end - - subroutine lmppm(dm, a6, ar, al, p, im, lmt) - implicit none - real*8 r12 - parameter ( r12 = 1./12. ) - - integer im, lmt - integer i - real*8 a6(im),ar(im),al(im),p(im),dm(im) - real*8 da1, da2, fmin, a6da - -! LMT = 0: full monotonicity -! LMT = 1: semi-monotonic constraint (no undershoot) -! LMT = 2: positive-definite constraint - - if(lmt.eq.0) then - -! Full constraint - do 100 i=1,im - if(dm(i) .eq. 0.) then - ar(i) = p(i) - al(i) = p(i) - a6(i) = 0. - else - da1 = ar(i) - al(i) - da2 = da1**2 - a6da = a6(i)*da1 - if(a6da .lt. -da2) then - a6(i) = 3.*(al(i)-p(i)) - ar(i) = al(i) - a6(i) - elseif(a6da .gt. da2) then - a6(i) = 3.*(ar(i)-p(i)) - al(i) = ar(i) - a6(i) - endif - endif -100 continue - - elseif(lmt == 1) then -! Semi-monotonic constraint - do 150 i=1,im - if(abs(ar(i)-al(i)) .ge. -a6(i)) go to 150 - if(p(i).lt.ar(i) .and. p(i).lt.al(i)) then - ar(i) = p(i) - al(i) = p(i) - a6(i) = 0. - elseif(ar(i) .gt. al(i)) then - a6(i) = 3.*(al(i)-p(i)) - ar(i) = al(i) - a6(i) - else - a6(i) = 3.*(ar(i)-p(i)) - al(i) = ar(i) - a6(i) - endif -150 continue - elseif(lmt == 2) then -! Positive definite constraint - do 250 i=1,im - if(abs(ar(i)-al(i)) >= -a6(i)) go to 250 - fmin = p(i) + 0.25*(ar(i)-al(i))**2/a6(i) + a6(i)*r12 - if(fmin >= 0.) go to 250 - if(p(i).lt.ar(i) .and. p(i).lt.al(i)) then - ar(i) = p(i) - al(i) = p(i) - a6(i) = 0. - elseif(ar(i) .gt. al(i)) then - a6(i) = 3.*(al(i)-p(i)) - ar(i) = al(i) - a6(i) - else - a6(i) = 3.*(ar(i)-p(i)) - al(i) = ar(i) - a6(i) - endif -250 continue - endif - return - end - - subroutine huynh(im, ar, al, p, d2, d1) - -! Enforce Huynh's 2nd constraint in 1D periodic domain - - implicit none - integer im, i - real*8 ar(im) - real*8 al(im) - real*8 p(im) - real*8 d2(im) - real*8 d1(im) - -! Local scalars: - real*8 pmp - real*8 lac - real*8 pmin - real*8 pmax - -! Compute d1 and d2 - d1(1) = p(1) - p(im) - do i=2,im - d1(i) = p(i) - p(i-1) - enddo - - do i=1,im-1 - d2(i) = d1(i+1) - d1(i) - enddo - d2(im) = d1(1) - d1(im) - -! Constraint for AR -! i = 1 - pmp = p(1) + 2.0 * d1(1) - lac = p(1) + 0.5 * (d1(1)+d2(im)) + d2(im) - pmin = min(p(1), pmp, lac) - pmax = max(p(1), pmp, lac) - ar(1) = min(pmax, max(ar(1), pmin)) - - do i=2, im - pmp = p(i) + 2.0*d1(i) - lac = p(i) + 0.5*(d1(i)+d2(i-1)) + d2(i-1) - pmin = min(p(i), pmp, lac) - pmax = max(p(i), pmp, lac) - ar(i) = min(pmax, max(ar(i), pmin)) - enddo - -! Constraint for AL - do i=1, im-1 - pmp = p(i) - 2.0*d1(i+1) - lac = p(i) + 0.5*(d2(i+1)-d1(i+1)) + d2(i+1) - pmin = min(p(i), pmp, lac) - pmax = max(p(i), pmp, lac) - al(i) = min(pmax, max(al(i), pmin)) - enddo - -! i=im - i = im - pmp = p(im) - 2.0*d1(1) - lac = p(im) + 0.5*(d2(1)-d1(1)) + d2(1) - pmin = min(p(im), pmp, lac) - pmax = max(p(im), pmp, lac) - al(im) = min(pmax, max(al(im), pmin)) - -! compute A6 (d2) - do i=1, im - d2(i) = 3.*(p(i)+p(i) - (al(i)+ar(i))) - enddo - return - end - - subroutine plft2d(im, jm, p, JS, JN, ndeg) -! -! This is a weak LOCAL polar filter. -! Developer: Shian-Jiann Lin - - implicit none - - integer im - integer jm - integer js, jn, ndeg - real*8 p(im,jm) - - integer i, j, n, ideg, jj, jc - real*8 cosp(jm),cose(jm) - real*8 a(0:im/2+1) - - real*8 sine(jm),sinp(jm) - real*8, allocatable, save :: se(:), sc(:) - - real*8 pi, dp, dl, e0, ycrit, coszc, smax, rn, rn2, esl, tmp - - data IDEG /0/ - - if(IDEG .ne. ndeg) then - IDEG = ndeg -! (e0 = 2.6) - e0 = 0.5 * sqrt(27.) - PI = 4. * ATAN(1.) - - allocate( sc(jm), se(jm)) - - call setrig(im, jm, dp, dl, cosp, cose, sinp, sine) - - ycrit = IDEG*PI/180. - coszc = cos(ycrit) - - smax = (jm-1)/2 - write(6,*) 'Critical latitude in local pft = ',ndeg - - a(0) = 1. - do n=1,im/2+1 - rn = n - rn2 = 2*n - a(n) = sqrt(rn2+1.) * ((rn2+1.)/rn2)**rn - enddo - - do j=2,jm-1 - sc(j) = coszc / cosp(j) - - IF(sc(j) > 1. .and. sc(j) <= 1.5 ) THEN - esl = 1./ sc(j) - sc(j) = 1. + (1.-esl) / (1.+esl) - ELSEIF(sc(j) > 1.5 .and. sc(j) <= e0 ) THEN - esl = 1./ sc(j) - sc(j) = 1. + 2./ (27.*esl**2 - 2.) - ELSEIF(sc(j) > e0) THEN -! Search - do jj=1,im/2 - if(sc(j) <= a(jj)) then - jc = jj -! write(*,*) 'jc=', jc - goto 111 - endif - enddo - jc = im/2 + 1 -111 continue - - tmp = ((sc(j) - a(jc-1))/(a(jc) - a(jc-1)))**0.25 - sc(j) = jc + min(1.d0, tmp) -! sc(j) = min(smax,sc(j)) - ENDIF - enddo -! ==================================================== - do j=2,jm - se(j) = coszc / cose(j) - IF(se(j) > 1. .and. se(j) <= 1.5 ) THEN - esl = 1./ se(j) - se(j) = 1. + (1.-esl) / (1.+esl) - ELSEIF(se(j) > 1.5 .and. se(j) <= e0 ) THEN - esl = 1./ se(j) - se(j) = 1. + 2./ (27.*esl**2 - 2.) - ELSEIF(se(j) > e0) THEN -! Search - do jj=1,im/2 - if(se(j) <= a(jj)) then - jc = jj - goto 222 - endif - enddo - - jc = im/2 + 1 -222 continue - tmp = ((se(j) - a(jc-1))/(a(jc) - a(jc-1)))**0.25 - se(j) = jc + min(1.d0, tmp) -! se(j) = min(smax,se(j)) - ENDIF - enddo - - do i=1,im - se( 2) = sc(2) - se(jm) = sc(jm-1) - enddo - - do j=2,jm-1 -! write(*,*) j,sc(j) - enddo - ENDIF - - if( JN == (jm-1) ) then -! Cell-centered variables - call lpft(im, jm, p, 2, jm-1, Sc) - else -! Cell-edge variables - call lpft(im, jm, p, 2, jm, Se) - endif - return - end - - - subroutine lpft(im, jm, p, j1, j2, s) - implicit none - - integer im, jm, j1, j2 - real*8 p(im,jm) - real*8 s(jm) - -! Local - integer i, j, n, nt - - real*8 ptmp(0:im+1) - real*8 q(0:im+1) - real*8 frac, rsc, bt - - do 2500 j=j1,j2 - if(s(j) > 1.02) then - - NT = INT(S(j)) - frac = S(j) - NT - NT = NT-1 - - rsc = 1. / (1.+frac) - bt = 0.5 * frac - - do i=1,im - ptmp(i) = p(i,j) - enddo - - ptmp(0) = p(im,j) - ptmp(im+1) = p(1 ,j) - - if( NT < 1 ) then - do i=1,im - p(i,j) = rsc * (ptmp(i) + bt*(ptmp(i-1)+ptmp(i+1))) - enddo - else - do i=1,im - q(i) = rsc * (ptmp(i) + bt*(ptmp(i-1)+ptmp(i+1))) - enddo - - do 500 N=1,NT - q(0) = q(im) - do i=1,im - ptmp(i) = q(i) + q(i-1) - enddo - ptmp(im+1) = ptmp(1) - - if ( n == nt ) then - do i=1,im - p(i,j) = 0.25*(ptmp(i) + ptmp(i+1)) - enddo - else - do i=1,im - q(i) = 0.25*(ptmp(i) + ptmp(i+1)) - enddo - endif -500 continue - endif - endif -2500 continue - - return - end diff --git a/tools/definesurf/map_i.f90 b/tools/definesurf/map_i.f90 deleted file mode 100644 index d73e02e7db..0000000000 --- a/tools/definesurf/map_i.f90 +++ /dev/null @@ -1,136 +0,0 @@ -subroutine map_i (nlon_i , nlat_i , numlon_i, lon_i , lat_i, & - nlon_o , nlat_o , numlon_o, lon_o , lat_o, & - mxovr_i2o, iovr_i2o, jovr_i2o, wovr_i2o) - - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none - -! ------------------------ code history --------------------------- -! source file: map_i.F -! purpose: driver for area averaging initialization -! date last revised: July 2000 -! author: Mariana Vertenstein -! ----------------------------------------------------------------- - -! ------------------------ notes ---------------------------------- -! o get indices and weights for area-averaging: -! -! from input surface grid to output model grid -! -! o input surface and output model grids can be any resolution BUT: -! -! both grids must be oriented south to north, i.e., cell(lat+1) -! must be north of cell(lat). the southern edge of the first row -! must be -90 (south pole) and the northern edge of the last row -! must be +90 (north pole) -! -! both grids must be oriented eastwards, i.e., cell(lon+1) must be -! east of cell(lon). but the two grids do not have to start at the -! same longitude, i.e., one grid can start at dateline and go east; -! the other grid can start at greenwich and go east. longitudes for -! the western edge of the cells must increase continuously and span -! 360 degrees. examples -! dateline : -180 to 180 (- longitudes west of greenwich) -! greenwich : 0 to 360 -! greenwich (centered): -dx/2 to -dx/2 + 360 (- longitudes west of greenwich) -! -! o field values fld_i on an input grid with dimensions nlon_i and nlat_i => -! field values fld_o on an output grid with dimensions nlon_o and nlat_o as -! -! fld_o(io,jo) = -! fld_i(i_ovr(io,jo, 1 ),j_ovr(io,jo, 1 )) * w_ovr(io,jo, 1 ) + -! fld_i(i_ovr(io,jo,mxovr_i),j_ovr(io,jo,mxovr_i)) * w_ovr(io,jo,mxovr_i) -! -! o error checks: -! overlap weights of input cells sum to 1 for each output cell -! global sums of dummy fields are conserved for input => model area-averaging -! ----------------------------------------------------------------- - -! ------------------- arguments ----------------------------------- - integer , intent(in) :: nlon_i !input grid max number of longitude points - integer , intent(in) :: nlat_i !input grid number of latitude points - integer , intent(in) :: numlon_i(nlat_i) !input grid number of longitude points at each lat - real(r8), intent(in) :: lon_i(nlon_i+1,nlat_i) !input grid cell longitude, west edge (degrees) - real(r8), intent(in) :: lat_i(nlat_i+1) !input grid cell latitude, south edge (degrees) - integer , intent(in) :: nlon_o !model grid max number of longitude points - integer , intent(in) :: nlat_o !model grid number of latitude points - integer , intent(in) :: numlon_o(nlat_o) !model grid number of longitude points at each lat - real(r8), intent(in) :: lon_o(nlon_o+1,nlat_o) !model grid cell longitude, west edge (degrees) - real(r8), intent(in) :: lat_o(nlat_o+1) !model grid cell latitude, south edge (degrees) - integer , intent(in) :: mxovr_i2o !max number of input cells that overlap model cell - integer , intent(out):: iovr_i2o(nlon_o,nlat_o,mxovr_i2o) !lon index of overlap input cell - integer , intent(out):: jovr_i2o(nlon_o,nlat_o,mxovr_i2o) !lat index of overlap input cell - real(r8), intent(out):: wovr_i2o(nlon_o,nlat_o,mxovr_i2o) !weight of overlap input cell -! ----------------------------------------------------------------- -! -! ------------------- local variables ----------------------------- -! - real(r8) fld_i(nlon_i,nlat_i) !dummy input grid field - real(r8) fld_o(nlon_o,nlat_o) !dummy model grid field - real(r8) area_i(nlon_i,nlat_i) !input grid cell area - real(r8) area_o(nlon_o,nlat_o) !model grid cell area - real(r8) re !radius of earth - real(r8) sum_fldo !global sum of dummy model field - real(r8) sum_fldi !global sum of dummy input field - integer io,ii !model and input longitude loop indices - integer jo,ji !model and input latitude loop indices - real(r8), parameter :: relerr = 0.000001 !relative error for error checks -! ----------------------------------------------------------------- - -! ----------------------------------------------------------------- -! get cell areas -! ----------------------------------------------------------------- - - call cell_area (nlat_i, nlon_i, numlon_i, lon_i, lat_i, re, area_i) - - call cell_area (nlat_o, nlon_o, numlon_o, lon_o, lat_o, re, area_o) - -! ----------------------------------------------------------------- -! get indices and weights for mapping from input grid to model grid -! ----------------------------------------------------------------- - - call ao_i (nlon_i , nlat_i , numlon_i, lon_i , lat_i , & - nlon_o , nlat_o , numlon_o, lon_o , lat_o , & - mxovr_i2o, iovr_i2o , jovr_i2o, wovr_i2o , re , & - area_o , relerr ) - -! ----------------------------------------------------------------- -! error check: global sum fld_o = global sum fld_i -! ----------------------------------------------------------------- -! -! make dummy input field and sum globally -! - sum_fldi = 0. - do ji = 1, nlat_i - do ii = 1, numlon_i(ji) - fld_i(ii,ji) = (ji-1)*nlon_i + ii - sum_fldi = sum_fldi + area_i(ii,ji)*fld_i(ii,ji) - end do - end do -! -! area-average model field from input field -! - call area_ave (nlat_i , nlon_i , numlon_i ,fld_i , & - nlat_o , nlon_o , numlon_o ,fld_o , & - iovr_i2o , jovr_i2o , wovr_i2o , mxovr_i2o) -! -! global sum of model field -! - sum_fldo = 0. - do jo = 1, nlat_o - do io = 1, numlon_o(jo) - sum_fldo = sum_fldo + area_o(io,jo)*fld_o(io,jo) - end do - end do -! -! check for conservation -! - if ( abs(sum_fldo/sum_fldi-1.) > relerr ) then - write (6,*) 'map_i error srf => model: srf field not conserved' - write (6,'(a23,e20.10)') 'global sum model field = ',sum_fldo - write (6,'(a23,e20.10)') 'global sum srf field = ',sum_fldi - call endrun - end if - - return -end subroutine map_i diff --git a/tools/definesurf/max_ovr.f90 b/tools/definesurf/max_ovr.f90 deleted file mode 100644 index 46b01fdc38..0000000000 --- a/tools/definesurf/max_ovr.f90 +++ /dev/null @@ -1,93 +0,0 @@ -subroutine max_ovr (nlon_i, nlat_i, numlon_i, nlon_o, nlat_o, numlon_o, & - lon_i , lat_i , lon_o , lat_o , novr_max) - - use shr_kind_mod, only: r8 => shr_kind_r8 - -! ----------------------------------------------------------------- - implicit none -! ------------------------ code history --------------------------- -! source file: max_ovr -! purpose: determine maximum number of overlapping cells -! input and output grids -! date last revised: March 1997 -! author: Mariana Vertenstein -! standardized: -! reviewed: -! ----------------------------------------------------------------- - -! ------------------- input variables ----------------------------- - integer, intent(in) :: nlon_i !number of input longitude points - integer, intent(in) :: nlat_i !number of input latitude points - integer, intent(in) :: numlon_i(nlat_i) !number of longitude points for each input grid cell latitude - integer, intent(in) :: nlon_o !number of output longitude points - integer, intent(in) :: nlat_o !number of output latitude points - integer, intent(in) :: numlon_o(nlat_o) !number of longitude points for each output grid cell latitude - real(r8), intent(in) :: lon_i(nlon_i+1,nlat_i) !input grid cell longitude, western edge - real(r8), intent(in) :: lat_i(nlat_i+1) !input grid cell latitude, southern edge - real(r8), intent(in) :: lon_o(nlon_o+1,nlat_o) !output grid cell longitude, western edge - real(r8), intent(in) :: lat_o(nlat_o+1) !output grid cell latitude , southern edge - integer , intent(out):: novr_max !maximum number of overlapping input cells -! ----------------------------------------------------------------- - -! ------------------- local variables ----------------------------- - integer novr !number of overlapping input cells - integer io,ii !output and input grids longitude loop index - integer jo,ji !output and input grids latitude loop index -! ----------------------------------------------------------------- - - -! ----------------------------------------------------------------- -! for each output grid cell: find overlapping input grid cell and area of -! input grid cell that overlaps with output grid cell. cells overlap if: -! -! southern edge of input grid < northern edge of output grid AND -! northern edge of input grid > southern edge of output grid -! -! western edge of input grid < eastern edge of output grid AND -! eastern edge of input grid > western edge of output grid -! -! lon_o(io,jo) lon_o(io+1,jo) -! -! | | -! --------------------- lat_o(jo+1) -! | | -! | | -! xxxxxxxxxxxxxxx lat_i(ji+1) | -! x | x | -! x input | x output | -! x cell | x cell | -! x ii,ji | x io,jo | -! x | x | -! x ----x---------------- lat_o(jo ) -! x x -! xxxxxxxxxxxxxxx lat_i(ji ) -! x x -! lon_i(ii,ji) lon_i(ii+1,ji) -! ----------------------------------------------------------------- - -! -! determine maximum number of overlapping cells -! loop through all input grid cells to find overlap with output grid. -! code does not vectorize but is only called during initialization. -! - novr_max = 0 - do jo = 1, nlat_o - do io = 1, numlon_o(jo) - novr = 0 - do ji = 1, nlat_i - if (lat_i(ji ).lt.lat_o(jo+1) .and. & - lat_i(ji+1).gt.lat_o(jo )) then !lat ok - do ii = 1, numlon_i(ji) - if (lon_i(ii ,ji).lt.lon_o(io+1,jo) .and. & - lon_i(ii+1,ji).gt.lon_o(io ,jo)) then !lon okay - novr = novr + 1 ! increment number of ovrlap cells for io,jo - end if - end do - end if - end do - if (novr .gt. novr_max) novr_max = novr - end do - end do - - return -end subroutine max_ovr diff --git a/tools/definesurf/sghphis.f90 b/tools/definesurf/sghphis.f90 deleted file mode 100644 index 39a694aa84..0000000000 --- a/tools/definesurf/sghphis.f90 +++ /dev/null @@ -1,340 +0,0 @@ -subroutine sghphis (plon, plat, numlons, mlatcnts, mloncnts, & - topofile, verbose, sgh, sgh30, have_sgh30, phis, fland ) - -!----------------------------------------------------------------------- -! -! Read high resolution topo dataset and calculate values of phis and sgh -! for the model resolution this model -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - - implicit none - include 'netcdf.inc' -! -!----------------------------------------------------------------------- -! -! parameters -! - integer , parameter :: ntopolon = 2160 - integer , parameter :: ntopolat = 1080 - integer , parameter :: n2x2lon = 180 - integer , parameter :: n2x2lat = 90 - integer , parameter :: n3x3lon = 120 - integer , parameter :: n3x3lat = 60 - real(r8), parameter :: r8_360 = 360. ! For argument compatibility to mod -! -! arguments -! - integer , intent(in) :: plon ! maximum number of model longitudes - integer , intent(in) :: plat ! number of model latitudes - integer , intent(in) :: numlons(plat) ! number of model longitudes per latitude - real(r8), intent(in) :: mlatcnts(plat) ! model cell center latitudes - real(r8), intent(in) :: mloncnts(plon,plat) ! model cell ceneter longitudes - logical , intent(in) :: verbose ! true => verbose output - character(len=*), intent(in) :: topofile ! high resolution topo file - real(r8), intent(out):: phis(plon,plat) ! model geopotention height - real(r8), intent(out):: sgh(plon,plat) ! model standard dev of geopotential height above 10min - real(r8), intent(out):: sgh30(plon,plat) ! model standard dev of geopotential height from 30s to 10m - logical , intent(out):: have_sgh30 ! true => variance is on topofile, sgh30 will be output - real(r8), intent(out):: fland(plon,plat) ! model fractional land -! -! Local workspace : note that anything with plon or plat in its dimension is dynamic -! - real(r8) wt ! weight for area averaging - real(r8) dx,dy ! increments for definition of intermed grid - -! high resolution topo grid - - integer lonid_topo, latid_topo ! input topo file vars - integer htopoid,ftopoid,ret,varianceid ! input topo file vars - real(r8) tloncnts(ntopolon) ! topo cell center lon boundaries - real(r8) tlatcnts(ntopolat) ! topo cell center lat boundaries - real(r8) tlons(ntopolon+1,ntopolat) ! topo cell W lon boundaries - real(r8) tlats(ntopolat+1) ! topo cell N lat boundaries - real(r8) ftopo(ntopolon,ntopolat) ! Land fraction array - real(r8) htopo(ntopolon,ntopolat) ! Topographic heights - real(r8) variance(ntopolon,ntopolat) ! Variance of elev at 30sec - -! intermediate grid - - real(r8) lons3x3(n3x3lon+1,n3x3lat) ! list of topo cell W lon boundaries - real(r8) lats3x3(n3x3lat+1) ! list of topo cell N lat boundaries - integer num3x3lons(n3x3lat) ! number if longitudes per latitude - real(r8) mnhgt3x3(n3x3lon,n3x3lat) ! intermediate topo height - real(r8) varhgt3x3(n3x3lon,n3x3lat) ! intermediate topovariance - -! model grid - - real(r8) mlons(plon+1,plat) ! model cell W lon boundaries - real(r8) mlats(plat+1) ! model cell N lat boundaries - real(r8) mnhgt(plon,plat) ! model topographic height - real(r8) varhgt(plon,plat) ! model topographic variance - real(r8) summn, sumvar ! use only for pole point calculations - -! other vars - - real(r8) xmax ! temporary variable - real(r8), parameter :: eps = 1.e-6 ! eps criterion for pole point - integer imax, jmax ! indices - integer i,j,ii,ji,io,jo,n ! indices - integer ncid_topo ! topographic netcdf id - integer ioe - integer mxovr ! max number of fine grid points used in area calculation of model grid point -! -! Space needed in 3 dimensions to store the initial data. This space is -! required because the input data file does not have a predetermined -! ordering of the latitude records. A specific order is imposed in the -! transforms so that the results will be reproducible. -! -! Dynamic -! - integer , allocatable :: iovr(:,:,:) ! lon index of overlap input cell - integer , allocatable :: jovr(:,:,:) ! lat index of overlap input cell - real(r8), allocatable :: wovr(:,:,:) ! weight of overlap input cell -! -!----------------------------------------------------------------------- -! -!---------------------------------------------------------------------------- -! Read in navy topo cell locations and determine cell edges (Uniform grid) -!---------------------------------------------------------------------------- -! - ret = nf_open (topofile, nf_nowrite, ncid_topo) - if (ret == nf_noerr) then - if (verbose) write(6,*)'Successfully opened netcdf topofile ',trim(topofile) - ret = nf_inq_varid (ncid_topo, 'variance', varianceid) - if (ret == NF_NOERR) then - if (verbose) write(6,*)'Found a new style topofile.' - call wrap_get_var8 (ncid_topo, varianceid, variance ) - call wrap_inq_varid (ncid_topo, 'landfract', ftopoid ) - have_sgh30 = .true. - else - if (verbose) write(6,*)'Found an old style topofile.' - call wrap_inq_varid (ncid_topo, 'ftopo', ftopoid ) - have_sgh30 = .false. - end if - call wrap_get_var8 (ncid_topo, ftopoid, ftopo) - call wrap_inq_varid (ncid_topo, 'htopo', htopoid ) - call wrap_get_var8 (ncid_topo, htopoid, htopo) - else - write(6,*)'cannot open topo file successfully' - call endrun - endif - - call wrap_inq_varid (ncid_topo, 'lon', lonid_topo) - call wrap_inq_varid (ncid_topo, 'lat', latid_topo) - - call wrap_get_var8 (ncid_topo, latid_topo, tlatcnts) - call wrap_get_var8 (ncid_topo, lonid_topo, tloncnts) - ret = nf_close (ncid_topo) - - tloncnts(:) = mod(tloncnts(:)+r8_360,r8_360) - - tlats(:) = 1.e36 - tlats(1) = -90. ! south pole - do j = 2, ntopolat - tlats(j) = (tlatcnts(j-1) + tlatcnts(j)) / 2. ! southern edges - end do - tlats(ntopolat+1) = 90. ! north pole - - tlons(:,:) = 1.e36 - do j = 1,ntopolat - dx = 360./ntopolon - tlons(1,j) = tloncnts(1) - dx/2. - do i = 2, ntopolon - tlons(i,j) = tloncnts(i) - dx/2. - end do - tlons(ntopolon+1,j) = tloncnts(ntopolon) + dx/2. - end do -! -!---------------------------------------------------------------------------- -! Determine model cell edges -!---------------------------------------------------------------------------- -! - mlats(:) = 1.e36 - mlats(1) = -90. ! south pole - do j = 2,plat - mlats(j) = (mlatcnts(j-1) + mlatcnts(j)) / 2. ! southern edges - end do - mlats(plat+1) = 90. ! north pole - - do j = 1,plat - dx = 360./(numlons(j)) - do i = 1,plon+1 - mlons(i,j) = -dx/2. + (i-1)*dx - end do - end do - -! -!---------------------------------------------------------------------------- -! Calculate fractional land -!---------------------------------------------------------------------------- -! - call binf2c(tloncnts ,tlatcnts ,ntopolon ,ntopolat ,ftopo, & - mlons ,mlats ,plon ,plat ,fland) -! -!---------------------------------------------------------------------------- -! Calculate standard deviation of elevation from 30sec to 10min -!---------------------------------------------------------------------------- - - if (have_sgh30) then - call binf2c(tloncnts ,tlatcnts ,ntopolon ,ntopolat ,variance, & - mlons ,mlats ,plon ,plat ,sgh30) - else - sgh30 = -1 - endif -!------------------------------------------------------------------------- -! Calculate determine mean and variance of topographic height, plon >=128 -!------------------------------------------------------------------------- -! - if (plon >= 128) then - call binf2c(tloncnts ,tlatcnts ,ntopolon ,ntopolat ,htopo, & - mlons ,mlats ,plon ,plat ,mnhgt) - - call varf2c(tloncnts ,tlatcnts ,ntopolon ,ntopolat ,htopo , & - mlons ,mlats ,plon ,plat ,mnhgt , & - varhgt ) - end if - -!------------------------------------------------------------------------- -! Calculate determine mean and variance of topographic height, plon < 128 -!------------------------------------------------------------------------- - - if (plon < 128) then -! -! bin to uniform 3x3 deg grid then area avg to output grid -! get 3x3 cell boundaries for binning routine -! - dy = 180./n3x3lat - do j = 1, n3x3lat+1 - lats3x3(j) = -90.0 + (j-1)*dy - end do - - num3x3lons(:) = n3x3lon - do j = 1,n3x3lat - dx = 360./(num3x3lons(j)) - do i = 1, num3x3lons(j)+1 - lons3x3(i,j) = 0. + (i-1)*dx - end do - end do -! -! bin mean height to intermed grid -! - call binf2c (tloncnts, tlatcnts, ntopolon, ntopolat, htopo, & - lons3x3 , lats3x3 , n3x3lon , n3x3lat , mnhgt3x3) -! -! get variation of topography mean height over the intermed grid -! - call varf2c (tloncnts, tlatcnts, ntopolon, ntopolat, htopo , & - lons3x3 , lats3x3 , n3x3lon , n3x3lat , mnhgt3x3, & - varhgt3x3 ) -! -! get maximum number of 3x3 cells which will to be used in area average -! for each model cell -! - call max_ovr (n3x3lon, n3x3lat, num3x3lons, plon , plat, numlons, & - lons3x3, lats3x3, mlons , mlats , mxovr ) -! -! do area average from intermediate regular grid to gauss grid -! get memory for pointer based arrays -! - allocate(iovr(plon,plat,mxovr)) - allocate(jovr(plon,plat,mxovr)) - allocate(wovr(plon,plat,mxovr)) - - call map_i (n3x3lon, n3x3lat, num3x3lons, lons3x3, lats3x3, & - plon , plat , numlons , mlons , mlats , & - mxovr , iovr , jovr , wovr ) - - do jo = 1, plat - do io = 1, numlons(jo) - mnhgt(io,jo) = 0. - varhgt(io,jo) = 0. - do n = 1, mxovr ! overlap cell index - ii = iovr(io,jo,n) ! lon index (input grid) of overlap cell - ji = jovr(io,jo,n) ! lat index (input grid) of overlap cell - wt = wovr(io,jo,n) ! overlap weight - mnhgt(io,jo) = mnhgt(io,jo) + mnhgt3x3(ii,ji) * wt - varhgt(io,jo) = varhgt(io,jo) + varhgt3x3(ii,ji) * wt - end do - end do - end do - -! If model grid contains pole points, then overwrite above values of phis and sgh at the -! poles with average of values of nearest 2x2 band - this is a fair approximation and -! is done so that above mapping routines do not have to be rewritten to correctly evaulte -! the area average of the pole points - - if (mlatcnts(1)-eps < -90.0 .and. mlatcnts(plat)+eps > 90.0) then - write(6,*)' determining sgh and phis at poles' - summn = 0 - sumvar = 0 - do io = 1,numlons(2) - summn = summn + mnhgt(io,2) - sumvar = sumvar + varhgt(io,2) - end do - do io = 1,numlons(1) - mnhgt(io,1) = summn/numlons(2) - varhgt(io,1) = sumvar/numlons(2) - end do - summn = 0 - sumvar = 0 - do io = 1,numlons(plat-1) - summn = summn + mnhgt(io,plat-1) - sumvar = sumvar + varhgt(io,plat-1) - end do - do io = 1,numlons(plat) - mnhgt(io,plat) = summn/numlons(plat-1) - varhgt(io,plat) = sumvar/numlons(plat-1) - end do - endif - - deallocate(iovr) - deallocate(jovr) - deallocate(wovr) - - end if - -! 1-2-1 smoothing for variation height - - call sm121(varhgt,plon,plat,numlons) - call sm121(varhgt,plon,plat,numlons) - if (have_sgh30) then - call sm121(sgh30,plon,plat,numlons) - call sm121(sgh30,plon,plat,numlons) - end if -! -! get standard deviation for smoothed height field -! -! determine geopotential height field. The multiplication by 9.80616 -! causes phis to be only accurate to 32-bit roundoff on some machines -! - xmax = -1.d99 - do jo=1,plat - do io=1,numlons(jo) - if (varhgt(io,jo) < 0.5) then - sgh(io,jo) = 0. - else - sgh(io,jo) = sqrt(varhgt(io,jo)) - end if - if (have_sgh30) then - if (sgh30(io,jo) < 0.5) then - sgh30(io,jo) = 0. - else - sgh30(io,jo) = sqrt(sgh30(io,jo)) - end if - end if - if (sgh(io,jo) > xmax) then - xmax = sgh(io,jo) - imax = io - jmax = jo - end if - phis(io,jo) = mnhgt(io,jo) * 9.80616 - end do - end do - - if (verbose) write(6,*)'Max SGH =',xmax,' at i,j=', imax, jmax - - return -end subroutine sghphis diff --git a/tools/definesurf/shr_kind_mod.f90 b/tools/definesurf/shr_kind_mod.f90 deleted file mode 100644 index fc1ed8e94a..0000000000 --- a/tools/definesurf/shr_kind_mod.f90 +++ /dev/null @@ -1,20 +0,0 @@ -!=============================================================================== -! CVS: $Id$ -! CVS: $Source$ -! CVS: $Name$ -!=============================================================================== - -MODULE shr_kind_mod - - !---------------------------------------------------------------------------- - ! precision/kind constants add data public - !---------------------------------------------------------------------------- - public - integer,parameter :: SHR_KIND_R8 = selected_real_kind(12) ! 8 byte real - integer,parameter :: SHR_KIND_R4 = selected_real_kind( 6) ! 4 byte real - integer,parameter :: SHR_KIND_RN = kind(1.0) ! native real - integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer - integer,parameter :: SHR_KIND_I4 = selected_int_kind ( 6) ! 4 byte integer - integer,parameter :: SHR_KIND_IN = kind(1) ! native integer - -END MODULE shr_kind_mod diff --git a/tools/definesurf/sm121.f90 b/tools/definesurf/sm121.f90 deleted file mode 100644 index c4b491616a..0000000000 --- a/tools/definesurf/sm121.f90 +++ /dev/null @@ -1,86 +0,0 @@ -subroutine sm121 (a, plon, nlat, nlon) - - use shr_kind_mod, only: r8 => shr_kind_r8 - -! -! perform 1-2-1 smoothing using data array a. On reduced grid, linearly -! interpolate to a rectangular grid (nlon(j),3) before interpolating -! -!----------------------------------------------------------------------- - implicit none -!-----------------------------Arguments--------------------------------- - - integer plon ! Input: Lon dim - integer nlat ! Input: Lat dim - integer nlon(nlat) ! Number of longitudes per latitude - real(r8) a(plon,nlat) ! I/O: Array to be smoothed - -!--------------------------Local variables------------------------------ - - integer i,j ! Indices - integer imin,imax ! Indices - integer jmax,jmin ! Indices -! -! Dynamic -! - real(r8) xin(plon,nlat) - real(r8) xout(plon) - real(r8) temp(plon,nlat) ! Temp array - real(r8) tempjmin(plon) ! Temp array - real(r8) tempjmax(plon) ! Temp array -! -!----------------------------------------------------------------------- -! - temp(:,:) = a(:,:) -! -! first do the S and N boundaries. -! - do i=1,nlon(1) - imin = i - 1 - imax = i + 1 - if( imin .lt. 1 ) imin = imin + nlon(1) - if( imax .gt. nlon(1)) imax = imax - nlon(1) - a(i,1) = (temp(imin,1) + 3.*temp(i,1) +temp(imax,1))/5. - end do - - do i=1,nlon(nlat) - imin = i - 1 - imax = i + 1 - if( imin .lt. 1 ) imin = imin + nlon(nlat) - if( imax .gt. nlon(nlat)) imax = imax - nlon(nlat) - a(i,nlat) = (temp(imin,nlat)+3.*temp(i,nlat)+temp(imax,nlat))/5. - end do -! -! Define xin array for each latitude -! - do j=1,nlat - do i=1,nlon(j) - xin(i,j) = (i-1)*360./nlon(j) - end do - end do -! -! Linearly interpolate data N and S of each target latitude to the longitudes -! of each target latitude before applying 1-2-1 filter -! - do j=2,nlat-1 - jmin = j - 1 - jmax = j + 1 - xout(:) = xin(:,j) - call lininterp (temp(1,jmin), nlon(jmin), 1, xin(1,jmin), & - tempjmin, nlon(j), 1, xout, .true.) - call lininterp (temp(1,jmax), nlon(jmax), 1, xin(1,jmax), & - tempjmax, nlon(j), 1, xout, .true.) - - do i=1,nlon(j) - imin = i - 1 - imax = i + 1 - if( imin .lt. 1 ) imin = imin + nlon(j) - if( imax .gt. nlon(j)) imax = imax - nlon(j) - a(i,j) = (tempjmin(i) + & - temp(imin,j) + 4.*temp(i,j) + temp(imax,j) + & - tempjmax(i) ) / 8. - enddo - enddo -! - return -end subroutine sm121 diff --git a/tools/definesurf/terrain_filter.f90 b/tools/definesurf/terrain_filter.f90 deleted file mode 100644 index fb80d9c492..0000000000 --- a/tools/definesurf/terrain_filter.f90 +++ /dev/null @@ -1,320 +0,0 @@ -! Terrain Filter -! -! Contributed by S.J. Lin. -! -! Added to the definesurf program by G. Grant, 30 June 2000. -! Updated with latest version from S.J. by B. Eaton, 23 August 2001 -! -! Notes from S.J.: -! -! "I compute the unsmoothed mean height and the variance -! exactly the same as the standard CCM utility. The only difference -! is the grid being uniformly spaced from North pole to South pole. -! The filter is applied to the mean height and the sqaure root of -! the variance (the standard deviation). -! -! For the 2x2.5 deg resolution -! -! mlon = 144 -! mlat = 91 -! -! Assuming the mean height is Z(mlon,mlat), and the standard deviation -! (the sqaure root of the variance) is SD(moln,mlat), the filter -! algorithm goes like this: -! -! call sm2(mlon, mlat, Z, itmax_Z, 0.25D0) -! call sm2(mlon, mlat, SD, itmax_SD, 0.25D0) -! -! where 0.25D0 is the dimensionless filter coefficient, and -! -! itmax_Z = 2*mlat -! itmax_SD = mlon -! -! [As discussed elsewhere] the above filtering is a bit too strong. -! But it is the filter I used up to now. -! I am currently testing the following setting -! -! itmax_Z = mlat/2 -! itmax_SD = mlon/4 -! " - - - subroutine sm2(im, jm, ht, itmax, c) -! -! Del-2 diffusion on the sphere -! - implicit none - -! Input: - integer im ! e-w dimension (eg, 144 for 2.5 deg resolution) - integer jm ! n-s doemsnion (eg, 91 for 2 deg resolution) - integer itmax ! iteration count - real*8 c ! filter coefficient - -! Input/Output - real*8 ht(im,jm) ! array to be filtered - -! Local - real*8 dg(im,jm) ! del2 of h - real*8 cose(jm), cosp(jm), sinp(jm), sine(jm) - real*8 dl - real*8 dp - real*8 fmin, fmax - integer jm1 - integer mnk, mxk - integer ndeg - integer it, i, j - real*8 s1, s2 - - jm1 = jm-1 - - call setrig(im, jm, dp, DL, cosp, cose, sinp, sine) - - call pmnx(ht, im, jm, fmin, fmax, mnk, mxk) - write(6,*) 'hmax=', fmax,' at j= ',mxk - write(6,*) 'hmin=', fmin,' at j= ',mnk - - ndeg = 60 ! starting latitude for the monotonicity - ! preserving polar filter - - call pmnx(ht,im,jm,fmin,fmax,mnk,mxk) - write(6,*) 'hmax=', fmax,' at j= ',mxk - write(6,*) 'hmin=', fmin,' at j= ',mnk - -! Apply Monotonicity preserving polar filter - call plft2d(im, jm, ht, 2, jm1, ndeg) - call avgp2(ht, sine, im, jm) - - do it=1,itmax - call del2(ht, im, jm, dg, cosp, cose, sine, DL, dp, ndeg) - call plft2d(im, jm, dg, 2, jm1, ndeg) - - do j=1,jm - do i=1,im - ht(i,j) = ht(i,j) + c*dg(i,j) - enddo - enddo - enddo - -! Final polar filter - call plft2d(im, jm, ht, 2, jm1, ndeg) - - return - end - - subroutine del2(h, im, jm, dg, cosp, cose, sine, dL, dp, ndeg) - implicit none - -! AE = 1 (unit radius) -! Input: - integer im - integer jm - integer ndeg -! Input-output - - real*8 h(im,jm) - real*8 dg(im,jm) ! del2 of h - real*8 cose(jm),cosp(jm) - real*8 sine(jm) - real*8 PI, ycrit, coszc, CD - real*8 DL, dp - -! Local - real*8 fx(im,jm) ! e-w fluxes - real*8 fy(im,jm) ! n-s fluxes - integer i, j - - call grad(h, im, jm, fx, fy, cosp, dl, dp) - - PI = 4. * ATAN(1.) - ycrit = float(ndeg)*PI/180. - coszc = cos(ycrit) - - CD = 0.25*DL*DP*coszc**2 -! CD = 0.25*DL*DP*cosp(2)**2 - - do j=2,jm-1 - do i=1,im - fx(i,j) = fx(i,j) * CD - enddo - enddo - - do j=2,jm - do i=1,im - fy(i,j) = fy(i,j) * CD - enddo - enddo - - call divg(im,jm,fx,fy,DG,cosp,cose,sine, dl, dp) - - return - end - - subroutine divg(im, jm, fx, fy, dg, cosp, cose, sine, dl, dp) - implicit none - - integer im - integer jm - real*8 fx(im,jm) ! e-w fluxes - real*8 fy(im,jm) ! n-s fluxes - real*8 DG(im,jm) ! del2 of h - real*8 wk(im,jm) - real*8 cosp(jm), cose(jm), sine(jm) - real*8 rdx - real*8 dl, dp, CDP, sum1, sum2 - integer i,j - - do j=2,jm-1 - - rdx = 1./ (cosp(j)*DL) - - do i=1,im-1 - DG(i,j) = (fx(i+1,j) - fx(i,j)) * rdx - enddo - DG(im,j) = (fx(1,j) - fx(im,j)) * rdx - enddo - - do j=2,jm - do i=1,im - wk(i,j) = fy(i,j) * cose(j) - enddo - enddo - - do j=2,jm-1 - CDP = 1./ (DP*cosp(j)) - do i=1,im - DG(i,j) = DG(i,j) + (wk(i,j+1) - wk(i,j)) * CDP - enddo - enddo - -! Poles; - - sum1 = wk(im, 2) - sum2 = wk(im,jm) - - do i=1,im-1 - sum1 = sum1 + wk(i, 2) - sum2 = sum2 + wk(i,jm) - enddo - - sum1 = sum1 / ( float(im)*(1.+sine(2)) ) - sum2 = -sum2 / ( float(im)*(1.+sine(2)) ) - - do i=1,im - DG(i, 1) = sum1 - DG(i,jm) = sum2 - enddo - - return - end - - subroutine grad(h, im, jm, fx, fy, cosp, DL, DP) - implicit none - integer im - integer jm - real*8 h(im,jm) - real*8 fx(im,jm) ! e-w fluxes - real*8 fy(im,jm) ! n-s fluxes - real*8 cosp(jm) - real*8 RDP, DL, DP, rdx - integer i, j - - RDP = 1./ DP - - do j=2,jm - do i=1,im - fy(i,j) = (h(i,j) - h(i,j-1)) * RDP - enddo - enddo - - do j=2,jm-1 - - rdx = 1./ (cosp(j)*DL) - fx(1,j) = (h(1,j) - h(im,j)) * rdx - do i=2,im - fx(i,j) = (h(i,j) - h(i-1,j)) * rdx - enddo - enddo - - return - end - - subroutine avgp2(p, sine, im, jm) - implicit none - integer im, jm - real*8 p(im,jm) - real*8 sine(jm) - real*8 sum1, sum2 - real*8 sum3, sum4 - real*8 rim - integer i - integer j - integer jm1 - - jm1 = jm-1 - rim = 1./ float(im) - - call sump2(p(1,1),p(1,jm),IM,sum1,sum2) - sum1 = sum1*(1.+sine(2)) - sum2 = sum2*(1.+sine(2)) - - call sump2(p(1,2),p(1,jm1),IM,sum3,sum4) - sum1 = rim * ( sum1 + sum3*(sine(3)-sine(2)) ) / (1.+sine(3)) - sum2 = rim * ( sum2 + sum4*(sine(3)-sine(2)) ) / (1.+sine(3)) - - do i=1,im - P(i, 1) = sum1 - P(i, 2) = sum1 - P(i,jm1) = sum2 - P(i, jm) = sum2 - enddo - return - end - - subroutine sump2(p1,p2,im,s1,s2) - implicit none - integer im,i - real*8 s1,s2 - real*8 p1(*),p2(*) - - s1 = p1(im) - s2 = p2(im) - - do i=1,im-1 - s1 = s1 + p1(i) - s2 = s2 + p2(i) - enddo - return - end - - subroutine pmnx(a,nx,ny,fmin,fmax,mnk,mxk) - implicit none - integer nx - integer ny - integer mnk - integer mxk - real*8 a(nx,*) - real*8 fmax, fmin, temp - integer i,j - - fmax = a(1,1) - fmin = a(1,1) - mnk = 1 - mxk = 1 - - do j=1,ny - do i=1,nx - temp = a(i,j) - if(temp.gt.fmax) then - fmax = temp - mxk = j - elseif(temp .lt. fmin) then - fmin = temp - mnk = j - endif - enddo - enddo - - return - end - diff --git a/tools/definesurf/varf2c.f90 b/tools/definesurf/varf2c.f90 deleted file mode 100644 index c7f638ff41..0000000000 --- a/tools/definesurf/varf2c.f90 +++ /dev/null @@ -1,219 +0,0 @@ -subroutine varf2c(flon ,flat ,nflon ,nflat ,fine , & - clon ,clat ,nclon ,nclat ,cmean , & - cvar ) - - use shr_kind_mod, only: r8 => shr_kind_r8 - -!----------------------------------------------------------------------------- -! Bin going from a fine grid to a coarse grid. -! A schematic for the coarse and fine grid systems is shown in -! Figure 1. This code assumes that each data point is represent -! it's surrounding area, called a cell. The first grid data point -! for both grids is assumed to be located at 0E (GM). This -! implies that the 1st cell for both the fine and the coarse grids -! strattles the Greenwich Meridian (GM). This code also assumes -! that there is no data wraparound (last data value is located at -! 360-dx). -! -! FIGURE 1: Overview of the coarse (X) and fine (@) grids -! longitudinal structure where: -! X = location of each coarse grid data point -! @ = location of each fine grid data point -! -! Greenwich Greenwich -! 0 Coarse cells 360 -! : v : -! clon(1): clon(2) v clon(3) clon(nclon): -! v : v v v v : -! xxxxxxxxxxxxxxxxxxxxxxxxxxxx..xxxxxxxxxxxxxxxx : -! x x x x x : -! x x x x x : -! x c(1) x c(2) x x c(nclon)x : -! x X x X x x X x : -! x ___ ___ ___ ___ ___ ___ ___ ___ ___ ___ ___ : -! x | | | | | | | | | | | | | : -! x | @ | @ | @ | @ | @ | @ |..| @ | @ | @ | @ | @ | : -! xxx|___|___|___|___|___|___| |___|___|___|___|___| : -! v v v v v : -! flon(1) flon(3) v flon(nflon-1) flon(nflon) -! : v : -! : Fine cells : -! 0 360 -! -! The Longitude/Latitude search: -! ------------------------------ -! -! Given a coarse grid cell with west and east boundaries of cWest -! and cEast and south and north boundaries of cSouth and cNorth -! (outlined by "x" in figure 2), find the indices of the fine grid -! points which are contained within the coarse grid cell. imin and -! imax are the indices fine grid points which overlap the western -! and eastern boundary of the coarse cell. jmin and jmax are the -! corresponding indices in the S-N direction. Bin these overlapping -! values to generate coarse(n), the coarse grid data values. -! -! FIGURE 2: Detail of Coarse and Fine cell overlap. -! @ = fine grid data point -! X = coarse grid data point -! -! cWest cEast -! | | x | | x | -! -@-------@---x---@-------@-----x-@- -! | | x*xxxxxxxxxxxxxxxxx*x|xx cNorth -! | | x | | x | -! | | x | | x | -! @-------@---x---@-------@-----x-@- jmax -! | | x | c(n) | x | -! | @ | x | | x | -! | | x | | x | -! @-------@---x---@-------@-----x-@- jmin -! | | x | | x | -! | @ | x*xxxxxxx@xxxxxxxxx*x|xx cSouth -! | | x | | x | -! -@-------@---x---@-------@-----x-@- -! | imin imax | -! -! -! When a cell coarse cell strattles the Greenwich Meridian -! --------------------------------------------------------- -! -! The first coarse grid cell strattles the GM, so when the western -! boundary of the coarse cell is < 0, an additional search is carried out. -! It ASSUMES that the easternmost fine grid point overlaps and searches -! westward from nflon, looking for a grid point west of clon(1) -! This generates a second set of longitudinal indices, imin1 and imax1. -! See Figure 3. -! -! Figure 3: Detail of Coarse cell strattling GM: -! ----------------------------------------------- -! -! Greenwich Greenwich -! 0 360 -! cWest : cEast cWest : -! clon(1): clon(2) clon(nclon+1)=clon(1) -! v : v v : -! xxxxxxxxxxxxxxxxxxxxxxx ... xxxxxxxxxxxxxxxx : -! x x x x x : -! x x x x x : -! x c(1) x x x c(nclon)x : -! x X x x x X x : -! x ___ ___ ___ _ ___ ___ ___ : -! x | | | | | | | : -! x | @ | @ | @ | @ | @ | @ | : -! xxx|___|___|___|_ ___|___|___| : -! ^ : ^ ^ ^ ^ : -! flon(1): ^ flon(3) flon(nflon-1) ^ : -! ^ : ^ ^ ^ : -! ^ :flon(2) ^ flon(nflon) -! ^ : ^ ^ ^ : -! imin : imax imin1 imax1 : -! : : -! -! -! In this case, imin=1, imax=2, imin1=nflon-1 and imax1=nflon. -! because the last two cells of the fine grid will have some -! contribution the the 1st cell of the coarse grid. -! -!----------------------------------------------------------------------- - implicit none -!-----------------------------Arguments--------------------------------- - - integer nflon ! Input: number of fine longitude points - integer nflat ! Input: number of fine latitude points - integer nclon ! Input: number of coarse longitude points - integer nclat ! Input: number of coarse latitude points - - real(r8) flon(nflon) ! Input: fine grid lons, centers (deg) - real(r8) flat(nflat) ! Input: fine grid lats, centers (deg) - real(r8) fine(nflon,nflat) ! Input: Fine grid data array - real(r8) clon(nclon+1,nclat) ! Input: coarse grid cell lons, west edge (deg) - real(r8) clat(nclat+1) ! Input: coarse grid cell lat, south edge (deg) - real(r8) cmean(nclon,nclat) ! Input: mean of fine points over coarse grid cell - real(r8) cvar (nclon,nclat) ! Output:variance of fine points over coarse cell - -!--------------------------Local variables------------------------------ - - real(r8) cWest ! Coarse cell longitude, west edge (deg) - real(r8) cEast ! Coarse cell longitude, east edge (deg) - real(r8) cSouth ! Coarse cell latitude, south edge (deg) - real(r8) cNorth ! Coarse cell latitude, notrh edge (deg) - real(r8) sum ! coarse tmp value - - integer i,j ! Indices - integer imin ,imax ! Max/Min E-W indices of intersecting fine cell. - integer imin1,imax1 ! fine E-W indices when coarse cell strattles GM - integer jmin ,jmax ! Max/Min N-S indices of intersecting fine cell. - integer iclon,jclat ! coarse grid indices - integer num ! increment - -!----------------------------------------------------------------------------- - - do jclat= 1,nclat ! loop over coarse latitudes - cSouth = clat(jclat) - cNorth = clat(jclat+1) - - do iclon=1,nclon ! loop over coarse longitudes - cWest = clon(iclon,jclat) - cEAST = clon(iclon+1,jclat) - -! 1. Normal longitude search: Find imin and imax - - imin = 0 - imax = 0 - do i=1,nflon-1 ! loop over fine lons, W -> E - if (flon(i) .gt. cEast) goto 10 ! fine grid point is E of coarse box - if (flon(i) .ge. cWest .and. imin.eq.0) imin=i - imax=i - enddo - -! 2. If cWest < 0, then coarse cell strattles GM. Hunt westward -! from the end to find indices of any overlapping fine grid cells: -! imin1 and imax1. - -10 imin1 = 0 ! borders for cWest, cEast - imax1 = -1 ! borders for cWest, cEast - if (cWest .lt. 0) then - cWest = cWest + 360. - imax1 = nflon - do i=nflon,1,-1 ! loop over fine lons, E -> W - imin1=i - if (flon(i) .le. cWest) goto 20 ! fine grid point is W of coarse box - enddo - endif - -! 3. Do the latitude search S -> N for jmin and jmax - -20 jmin = 0 - jmax = 0 - do j=1,nflat ! loop over fine lats, S -> N - if (flat(j) .gt. cNorth) goto 30 ! fine grid point is N of coarse box - if (flat(j) .ge. cSouth .and. jmin.eq.0) jmin=j - jmax=j - enddo -30 continue - -! 4. Sdv - - sum = 0. ! Initialize coarse data value - num = 0 - - do j=jmin,jmax ! loop over fine lats, S -> N - do i=imin,imax ! loop over fine lons, W -> E - sum = sum + (fine(i,j) - cmean(iclon,jclat))**2 - num = num + 1 - enddo - do i=imin1,imax1 ! If coarse cell strattles GM - sum = sum + (fine(i,j) - cmean(iclon,jclat))**2 - num = num + 1 - enddo - enddo - - if (num .gt. 0) then - cvar(iclon,jclat) = sum/num - else - cvar(iclon,jclat) = 1.e30 - endif - end do - end do - return -end subroutine varf2c diff --git a/tools/definesurf/wrap_nf.f90 b/tools/definesurf/wrap_nf.f90 deleted file mode 100644 index c340b3817b..0000000000 --- a/tools/definesurf/wrap_nf.f90 +++ /dev/null @@ -1,146 +0,0 @@ -subroutine wrap_inq_varid (nfid, varname, varid) - implicit none - include 'netcdf.inc' - - integer nfid, varid - character*(*) varname - - integer ret - - ret = nf_inq_varid (nfid, varname, varid) - if (ret.ne.NF_NOERR) call handle_error (ret) -end subroutine wrap_inq_varid - -subroutine wrap_inq_dimlen (nfid, dimid, dimlen) - implicit none - include 'netcdf.inc' - - integer nfid, dimid, dimlen - - integer ret - - ret = nf_inq_dimlen (nfid, dimid, dimlen) - if (ret.ne.NF_NOERR) call handle_error (ret) -end subroutine wrap_inq_dimlen - -subroutine wrap_inq_dimid (nfid, dimname, dimid) - implicit none - include 'netcdf.inc' - - integer nfid, dimid - character*(*) dimname - - integer ret - - ret = nf_inq_dimid (nfid, dimname, dimid) - if (ret.ne.NF_NOERR) call handle_error (ret) -end subroutine wrap_inq_dimid - -subroutine wrap_inq_var (nfid, varid, varname, xtype, ndims, dimids, natts) - implicit none - include 'netcdf.inc' - - integer nfid, varid, xtype, ndims, dimids(nf_max_dims), natts - character*(*) varname - - integer ret - - ret = nf_inq_var (nfid, varid, varname, xtype, ndims, dimids, natts) - if (ret.ne.NF_NOERR) call handle_error (ret) -end subroutine wrap_inq_var - -subroutine wrap_def_dim (nfid, dimname, len, dimid) - implicit none - include 'netcdf.inc' - - integer nfid, len, dimid - character*(*) dimname - - integer ret - - ret = nf_def_dim (nfid, dimname, len, dimid) - if (ret.ne.NF_NOERR) call handle_error (ret) -end subroutine wrap_def_dim - -subroutine wrap_get_var8 (nfid, varid, arr) - implicit none - include 'netcdf.inc' - - integer nfid, varid - real*8 arr(*) - - integer ret - - ret = nf_get_var_double (nfid, varid, arr) - if (ret.ne.NF_NOERR) call handle_error (ret) -end subroutine wrap_get_var8 - -subroutine wrap_put_var8 (nfid, varid, arr) - implicit none - include 'netcdf.inc' - - integer nfid, varid - real*8 arr(*) - - integer ret - ret = nf_put_var_double (nfid, varid, arr) - if (ret.ne.NF_NOERR) call handle_error (ret) -end subroutine wrap_put_var8 - -subroutine wrap_get_vara8 (nfid, varid, start, count, arr) - implicit none - include 'netcdf.inc' - - integer nfid, varid, start(*), count(*) - real*8 arr(*) - - integer ret - - ret = nf_get_vara_double (nfid, varid, start, count, arr) - if (ret.ne.NF_NOERR) call handle_error (ret) -end subroutine wrap_get_vara8 - -subroutine wrap_put_vara8 (nfid, varid, start, count, arr) - implicit none - include 'netcdf.inc' - - integer nfid, varid - integer start(*), count(*) - real*8 arr(*) - - integer ret - ret = nf_put_vara_double (nfid, varid, start, count, arr) - if (ret.ne.NF_NOERR) call handle_error (ret) -end subroutine wrap_put_vara8 - -subroutine wrap_put_att_text (nfid, varid, attname, atttext) - implicit none - include 'netcdf.inc' - - integer, intent(in):: nfid - integer, intent(in):: varid - character*(*), intent(in):: attname - character*(*), intent(in):: atttext - - integer ret ! NetCDF return code - integer siz - - siz = len_trim(atttext) - ret = nf_put_att_text (nfid, varid, attname, siz, atttext) - if (ret/=NF_NOERR) call handle_error (ret) -end subroutine wrap_put_att_text - -subroutine wrap_put_att_double (nfid, varid, name, xtype, len, dvals) - implicit none - include 'netcdf.inc' - - integer nfid, varid, xtype, len - character*(*) name - real*8 dvals - - integer ret - - ret = nf_put_att_double (nfid, varid, name, xtype, len, dvals) - if (ret.ne.NF_NOERR) call handle_error (ret) -end subroutine wrap_put_att_double - diff --git a/tools/topo_tool/bin_to_cube/Makefile b/tools/topo_tool/bin_to_cube/Makefile deleted file mode 100644 index 84d1b39138..0000000000 --- a/tools/topo_tool/bin_to_cube/Makefile +++ /dev/null @@ -1,82 +0,0 @@ -EXEDIR = . -EXENAME = bin_to_cube -RM = rm - -.SUFFIXES: -.SUFFIXES: .F90 .o - - -# -# setenv LD_LIBRARY_PATH ${LD_LIBRARY_PATH}:/usr/local/netcdf-4.1.3-gcc-4.4.4-13-lf9581/lib -# - -FC = lf95 -#DEBUG=TRUE - -# Check for the NetCDF library and include directories -ifeq ($(LIB_NETCDF),$(null)) -LIB_NETCDF := /usr/local/lib -endif - -ifeq ($(INC_NETCDF),$(null)) -INC_NETCDF := /usr/local/include -endif - -# Determine platform -UNAMES := $(shell uname -s) -UNAMEM := $(findstring CRAY,$(shell uname -m)) - - -#------------------------------------------------------------------------ -# LF95 -#------------------------------------------------------------------------ - -ifeq ($(FC),lf95) -# -# Tramhill -# - INC_NETCDF :=/usr/local/netcdf-4.1.3-gcc-4.4.4-13-lf9581/include - LIB_NETCDF :=/usr/local/netcdf-4.1.3-gcc-4.4.4-13-lf9581/lib - - LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -lnetcdff -lcurl -lhdf5 -lhdf5_hl -mcmodel=medium - FFLAGS := -c --trace --trap --wide -CcdRR8 -I$(INC_NETCDF) - ifeq ($(DEBUG),TRUE) - #TBH: this works FFLAGS += -g --chk --pca - #TBH: this FAILS FFLAGS += -g --chk a,e,s,u,x --pca - FFLAGS += -g --chk a,e,s,u --pca - else - FFLAGS += -O - endif - -endif - - -#------------------------------------------------------------------------ -# AIX -#------------------------------------------------------------------------ - -ifeq ($(UNAMES),AIX) -FC = xlf90 -FFLAGS = -c -I$(INC_NETCDF) -LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -.F90.o: - $(FC) $(FFLAGS) -qsuffix=f=F90 $< -endif - - -.F90.o: - $(FC) $(FFLAGS) $< - -#------------------------------------------------------------------------ -# Default rules and macros -#------------------------------------------------------------------------ - -OBJS := bin_to_cube.o shr_kind_mod.o - -$(EXEDIR)/$(EXENAME): $(OBJS) - $(FC) -o $@ $(OBJS) $(LDFLAGS) - -clean: - $(RM) -f $(OBJS) *.mod $(EXEDIR)/$(EXENAME) - -bin_to_cube.o: shr_kind_mod.o diff --git a/tools/topo_tool/bin_to_cube/README b/tools/topo_tool/bin_to_cube/README deleted file mode 100644 index aa65664798..0000000000 --- a/tools/topo_tool/bin_to_cube/README +++ /dev/null @@ -1,23 +0,0 @@ -This program reads USGS 30-sec terrain dataset from NetCDF file and bins it to an approximately -3km cubed-sphere grid and outputs the data in netCDF format. - -The LANDM_COSLAT field is read in from a separate netCDF file and linearly interpolated to the 3km cubed-sphere grid. - -Input files needed: - -1. USGS raw data in netCDF format: usgs-rawdata.nc (must be placed in same dirctory as the executables) - Generated with software in gen_netCDF_from_USGS/ directory - - File may be found at: - - $CESMDATA/inputdata/atm/cam/gtopo30data/usgs-rawdata.nc - -2. landm_coslat dataset (must be placed in same dirctory as the executables). E.g.: - - ln -s /fs/cgd/csm/inputdata/atm/cam2/hrtopo/landm_coslat.nc . - - The landm_coslat field is not used in CAM5! - -Output file: - -USGS-topo-cube.nc diff --git a/tools/topo_tool/bin_to_cube/bin_to_cube.F90 b/tools/topo_tool/bin_to_cube/bin_to_cube.F90 deleted file mode 100644 index 89ea086a37..0000000000 --- a/tools/topo_tool/bin_to_cube/bin_to_cube.F90 +++ /dev/null @@ -1,931 +0,0 @@ -! -! DATE CODED: Nov 7, 2011 -! -! DESCRIPTION: This program reads USGS 30-sec terrain dataset from NetCDF file and -! bins it to an approximately 3km cubed-sphere grid and outputs the -! data in netCDF format. -! -! The LANDM_COSLAT field is read in from a separate netCDF file and linearly -! interpolated to the 3km cubed-sphere grid. -! -! Author: Peter Hjort Lauritzen (pel@ucar.edu) -! -! ROUTINES CALLED: -! netcdf routines -! -! COMPILING: -! -program convterr - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none -# include - ! - integer :: im, jm - - integer, parameter :: ncube = 3000 !dimension of cubed-sphere grid -! integer, parameter :: ncube = 540 !dimension of cubed-sphere grid - ! integer, parameter :: ncube = 361 ! for debugging - - integer*2, allocatable, dimension(:,:) :: terr ! global 30-sec terrain data - integer*1, allocatable, dimension(:,:) :: landfrac ! global 30-sec land fraction - - integer :: alloc_error,dealloc_error - integer :: i,j,n,k,index ! index - integer*2, allocatable, dimension(:,:) :: iterr ! terrain data for 30-sec tile - integer ncid,status, dimlatid,dimlonid, landid, topoid ! for netCDF USGS data file - integer :: srcid,dstid ! for netCDF weight file - - real(r8), allocatable, dimension(:) :: lon , lat - real(r8), allocatable, dimension(:) :: lon_landm , lat_landm - real(r8), allocatable, dimension(:,:) :: landm_coslat - integer :: im_landm, jm_landm - integer :: lonid, latid - integer :: lon_vid, lat_vid - - REAL (r8), PARAMETER :: tiny = 1.0E-10 - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - REAL (r8), PARAMETER :: rad2deg = 180.0/pi - REAL (r8), PARAMETER :: deg2rad = pi/180.0 - - real(r8) :: alpha, beta,da,wt,dlat - integer :: ipanel,icube,jcube - real(r8), allocatable, dimension(:,:,:) :: weight,terr_cube,landfrac_cube,sgh30_cube - real(r8), allocatable, dimension(:,:,:) :: landm_coslat_cube - integer , allocatable, dimension(:,:) :: idx,idy,idp - ! - real(r8) :: dx,dy - ! - ! for "bi-linear" interpolation - ! - real(r8) :: lambda,theta,wx,wy - integer :: ilon,ilat,ip1,jp1 - ! - ! variable for regridding - ! - integer :: src_grid_dim ! for netCDF weight file - ! - ! this is only used if target grid is a lat-lon grid - ! - integer , parameter :: im_target = 360 , jm_target = 180 - logical , parameter :: ltarget_rll = .TRUE. - ! - ! this is only used if target grid is not a lat-lon grid - ! - real(r8), allocatable, dimension(:) :: lon_target, lat_target - ! - ! compute volume of surface topography - ! - real(r8) :: vol,dx_rad,vol_cube,area_latlon,darea_latlon ! latitude array - real(r8), allocatable, dimension(:,:) :: darea_cube - - ! - ! read in USGS data from netCDF file - ! - ! status = nf_open('topo-lowres.nc', 0, ncid) !for debugging - status = nf_open('usgs-rawdata.nc', 0, ncid) - IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) - - status = NF_INQ_DIMID(ncid, 'lat', dimlatid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - status = NF_INQ_DIMLEN(ncid, dimlatid, jm) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_INQ_DIMID(ncid, 'lon', dimlonid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - status = NF_INQ_DIMLEN(ncid, dimlonid, im) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - WRITE(*,*) "lon-lat dimensions: ",im,jm - - allocate ( landfrac(im,jm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - allocate ( terr(im,jm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for terr' - stop - end if - - allocate ( lon(im),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - allocate ( lat(jm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - terr = -999999 - landfrac = -99.0 - - status = NF_INQ_VARID(ncid, 'landfract', landid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_GET_VAR_INT1(ncid, landid,landfrac) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - WRITE(*,*) "min/max of 30sec land fraction",MINVAL(landfrac),MAXVAL(landfrac) - - - status = NF_INQ_VARID(ncid, 'htopo', topoid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - WRITE(*,*) "read terrain data" - status = NF_GET_VAR_INT2(ncid, topoid,terr) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_INQ_VARID(ncid, 'lon', lonid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - WRITE(*,*) "read lon" - status = NF_GET_VAR_DOUBLE(ncid, lonid,lon) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_INQ_VARID(ncid, 'lat', latid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - WRITE(*,*) "read lat" - status = NF_GET_VAR_DOUBLE(ncid, latid,lat) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - print *,"close file topo.nc" - status = nf_close (ncid) - if (status .ne. NF_NOERR) call handle_err(status) - - WRITE(*,*) 'done reading in USGS data from netCDF file' - - WRITE(*,*) "Adjustments to land fraction: Extend land fraction for Ross Ice shelf by" - WRITE(*,*) "setting all landfractions south of 79S to 1" - DO j=1,jm - IF (lat(j)<-79.0) THEN - DO i=1,im - landfrac(i,j) = 1 - END DO - END IF - END DO - - WRITE(*,*) "compute volume for USGS raw data" - vol = 0.0 - dx = (lon(2)-lon(1)) - dx_rad = dx*deg2rad - do j=1,jm - do i=1,im - darea_latlon = dx_rad*(SIN(deg2rad*(-90.0+dx*j))-SIN(deg2rad*(-90.0+dx*(j-1)))) - vol = vol+DBLE(terr(i,j))*darea_latlon - area_latlon = area_latlon + darea_latlon - end do - end do - vol = vol/area_latlon - WRITE(*,*) "consistency of lat-lon area",area_latlon-4.0*pi - WRITE(*,*) "volume of topography about sea-level (raw usgs data)",vol - - - ! - !**************************************************** - ! - ! read LANDM_COSLAT - ! - !**************************************************** - ! - WRITE(*,*) "read LANDM_COSLAT from file" - status = nf_open('landm_coslat.nc', 0, ncid) - IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) - - status = NF_INQ_DIMID(ncid, 'lat', dimlatid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - status = NF_INQ_DIMLEN(ncid, dimlatid, jm_landm) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_INQ_DIMID(ncid, 'lon', dimlonid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - status = NF_INQ_DIMLEN(ncid, dimlonid, im_landm) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - WRITE(*,*) "lon-lat dimensions: ",im_landm,jm_landm - - allocate ( landm_coslat(im_landm,jm_landm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - allocate ( lon_landm(im_landm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - allocate ( lat_landm(jm_landm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - do j = 1, jm_landm - do i = 1, im_landm - landm_coslat(i,j) = -999999.99 - end do - end do - - status = NF_INQ_VARID(ncid, 'LANDM_COSLAT', landid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_GET_VAR_DOUBLE(ncid, landid,landm_coslat) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - WRITE(*,*) "min/max of landm_coslat",MINVAL(landm_coslat),MAXVAL(landm_coslat) - - status = NF_INQ_VARID(ncid, 'lon', lonid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - WRITE(*,*) "read lon" - status = NF_GET_VAR_DOUBLE(ncid, lonid,lon_landm) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_INQ_VARID(ncid, 'lat', latid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - WRITE(*,*) "read lat" - status = NF_GET_VAR_DOUBLE(ncid, latid,lat_landm) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - print *,"close file" - status = nf_close (ncid) - if (status .ne. NF_NOERR) call handle_err(status) - - WRITE(*,*) 'done reading in LANDM_COSLAT data from netCDF file' - - ! - ! bin data on cubed-sphere grid - ! - da = pi / DBLE(2*ncube)!equal-angle cubed-sphere grid spacing - lon = deg2rad*lon - lat = deg2rad*lat - dlat = pi/DBLE(jm) - allocate ( weight(ncube,ncube,6),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for weight' - stop - end if - weight = 0.0 - allocate ( terr_cube(ncube,ncube,6),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for terr_cube' - stop - end if - terr_cube = 0.0 - allocate ( landfrac_cube(ncube,ncube,6),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for terr_cube' - stop - end if - landfrac_cube = 0.0 - allocate ( landm_coslat_cube(ncube,ncube,6),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for terr_cube' - stop - end if - landm_coslat_cube = 0.0 - - - allocate ( idx(im,jm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for idx' - stop - end if - allocate ( idy(im,jm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for idy' - stop - end if - allocate ( idp(im,jm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for idp' - stop - end if - - WRITE(*,*) "bin lat-lon data on cubed-sphere" - - ! - ! for debugging ONLY - ! -! DO j=1,jm -! DO i=1,im -!! terr(i,j) = 10000.0*(2.0+cos(lat(j))*cos(lat(j))*cos(2.0*lon(i)))!Y22 -!! terr(i,j) = 10000.0*(2.0+(sin(2.0*lat(j))**16)*cos(16.0*lon(i))) !Y16_32 -! terr(i,j) = 10000.0*(2.0+cos(16.0*lon(i))) !Y16_32 -! END DO -! END DO - - DO j=1,jm - DO i=1,im -! WRITE(*,*) "bin to cube ",100.0*FLOAT(i+(j-1)*im)/FLOAT(im*jm),"% done" - call CubedSphereABPFromRLL(lon(i), lat(j), alpha, beta, ipanel) - icube = CEILING((alpha + piq) / da) - jcube = CEILING((beta + piq) / da) - IF (icube<1.OR.icube>ncube.OR.jcube<1.OR.jcube>ncube) THEN - WRITE(*,*) "fatal error in search algorithm" - WRITE(*,*) "icube or jcube out of range: ",icube,jcube - STOP - END IF - wt = SIN( lat(j)+0.5*dlat ) - SIN( lat(j)-0.5*dlat ) - weight(icube,jcube,ipanel) = weight(icube,jcube,ipanel)+wt - ! - terr_cube (icube,jcube,ipanel) = terr_cube (icube,jcube,ipanel)+wt*DBLE(terr(i,j)) - landfrac_cube(icube,jcube,ipanel) = landfrac_cube(icube,jcube,ipanel)+wt*DBLE(landfrac(i,j)) - ! - ! save "index-association" for variance computation - ! - idx(i,j) = icube - idy(i,j) = jcube - idp(i,j) = ipanel - END DO - END DO - - dx = deg2rad*(lon_landm(2)-lon_landm(1)) - ! - ! lat_landm is not exactly equally spaced so a search is needed in the loop below - ! - dy = deg2rad*(lat_landm(2)-lat_landm(1)) - DO k=1,6 - DO j=1,ncube - DO i=1,ncube - IF (ABS(weight(i,j,k))<1.0E-9) THEN - WRITE(*,*) "there is no lat-lon grid point in cubed sphere cell ",i,j,k - WRITE(*,*) "fatal error" - STOP - ELSE - terr_cube (i,j,k) = terr_cube (i,j,k)/weight(i,j,k) - landfrac_cube (i,j,k) = landfrac_cube (i,j,k)/weight(i,j,k) - END IF - ! - ! linearly interpolate landm_coslat - ! - alpha = -piq+(i-0.5)*da - beta = -piq+(j-0.5)*da - CALL CubedSphereRLLFromABP(alpha, beta, k, lambda, theta) - IF (theta>lat_landm(jm_landm)*deg2rad-tiny) THEN - landm_coslat_cube(i,j,k) = 0.0 - ELSE IF (theta1.0.OR.wy<0.0) - jp1 = ilat+1 - wy = (theta -lat_landm(ilat)*deg2rad)/((lat_landm(jp1)-lat_landm(ilat))*deg2rad) - IF (wy>1.0) THEN - ilat=ilat+1 - ELSE IF (wy<0.0) THEN - ilat=ilat-1 - END IF - END DO - - IF (wx>1.0+tiny.OR.wx<0.0-tiny) THEN - WRITE(*,*) "wx out of range",wx - stop - END IF - IF (wy>1.0+tiny.OR.wy<0.0-tiny) THEN - WRITE(*,*) "wy out of range",wy - stop - END IF - ! - ! "crude" bi-linear interpolation - ! - landm_coslat_cube(i,j,k) =& - (1.0-wx)*(1.0-wy)*landm_coslat(ilon,ilat)+ wx *(1-wy)*landm_coslat(ip1,ilat)+& - (1.0-wx)* wy *landm_coslat(ilon,jp1 )+ wx * wy *landm_coslat(ip1,jp1) - END IF - END DO - END DO - END DO - WRITE(*,*) "min/max value of terr_cube:", MINVAL(terr_cube), MAXVAL(terr_cube) - WRITE(*,*) "min/max value of landm_coslat_cube:", MINVAL(landm_coslat_cube), MAXVAL(landm_coslat_cube) - ! - ! compute volume of topography on cubed-sphere - ! - WRITE(*,*) "compute volume for cubed-sphere binned data" - allocate (darea_cube(ncube,ncube),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for idp' - stop - end if - CALL EquiangularAllAreas(ncube, darea_cube) - vol_cube = 0.0 - do ipanel=1,6 - do j=1,ncube - do i=1,ncube - vol_cube = vol_cube+terr_cube(i,j,ipanel)*darea_cube(i,j) - end do - end do - end do - vol_cube=vol_cube/(4.0*pi) - deallocate(darea_cube) - WRITE(*,*) "mean height (globally) of topography about sea-level (3km cube data)",vol_cube,(vol_cube-vol)/vol - !********************************************************* - ! - ! compute variance - ! - !********************************************************* - ! - allocate ( sgh30_cube(ncube,ncube,6),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for sgh30_cube' - stop - end if - sgh30_cube = 0.0 - DO j=1,jm - DO i=1,im - icube = idx(i,j) - jcube = idy(i,j) - ipanel = idp(i,j) - wt = SIN( lat(j)+0.5*dlat ) - SIN( lat(j)-0.5*dlat ) - sgh30_cube(icube,jcube,ipanel) = sgh30_cube(icube,jcube,ipanel) + & - (wt*(terr_cube(icube,jcube,ipanel)-terr(i,j))**2)/weight(icube,jcube,ipanel) - END DO - END DO - ! sgh30_cube=sgh30_cube/weight - WRITE(*,*) "min/max value of sgh30_cube:", MINVAL(sgh30_cube), MAXVAL(sgh30_cube) - ! - ! write data to NetCDF file - ! - CALL wrt_cube(ncube,terr_cube,landfrac_cube,landm_coslat_cube,sgh30_cube) - DEALLOCATE(weight,terr,landfrac,idx,idy,idp,lat,lon) - WRITE(*,*) "done writing cubed sphere data" -end program convterr - - -!************************************************************************ -!!handle_err -!************************************************************************ -! -!!ROUTINE: handle_err -!!DESCRIPTION: error handler -!-------------------------------------------------------------------------- - -subroutine handle_err(status) - - implicit none - -# include - - integer status - - if (status .ne. nf_noerr) then - print *, nf_strerror(status) - stop 'Stopped' - endif - -end subroutine handle_err - - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereABPFromRLL -! -! Description: -! Determine the (alpha,beta,panel) coordinate of a point on the sphere from -! a given regular lat lon coordinate. -! -! Parameters: -! lon - Coordinate longitude -! lat - Coordinate latitude -! alpha (OUT) - Alpha coordinate -! beta (OUT) - Beta coordinate -! ipanel (OUT) - Face panel -!------------------------------------------------------------------------------ -SUBROUTINE CubedSphereABPFromRLL(lon, lat, alpha, beta, ipanel) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - - REAL (R8), INTENT(IN) :: lon, lat - REAL (R8), INTENT(OUT) :: alpha, beta - INTEGER, INTENT(OUT) :: ipanel - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - REAL (r8), PARAMETER :: rotate_cube = 0.0 - - ! Local variables - REAL (R8) :: xx, yy, zz, pm - REAL (R8) :: sx, sy, sz - INTEGER :: ix, iy, iz - - ! Translate to (x,y,z) space - xx = COS(lon-rotate_cube) * COS(lat) - yy = SIN(lon-rotate_cube) * COS(lat) - zz = SIN(lat) - - pm = MAX(ABS(xx), ABS(yy), ABS(zz)) - - ! Check maximality of the x coordinate - IF (pm == ABS(xx)) THEN - IF (xx > 0) THEN; ix = 1; ELSE; ix = -1; ENDIF - ELSE - ix = 0 - ENDIF - - ! Check maximality of the y coordinate - IF (pm == ABS(yy)) THEN - IF (yy > 0) THEN; iy = 1; ELSE; iy = -1; ENDIF - ELSE - iy = 0 - ENDIF - - ! Check maximality of the z coordinate - IF (pm == ABS(zz)) THEN - IF (zz > 0) THEN; iz = 1; ELSE; iz = -1; ENDIF - ELSE - iz = 0 - ENDIF - - ! Panel assignments - IF (iz == 1) THEN - ipanel = 6; sx = yy; sy = -xx; sz = zz - - ELSEIF (iz == -1) THEN - ipanel = 5; sx = yy; sy = xx; sz = -zz - - ELSEIF ((ix == 1) .AND. (iy /= 1)) THEN - ipanel = 1; sx = yy; sy = zz; sz = xx - - ELSEIF ((ix == -1) .AND. (iy /= -1)) THEN - ipanel = 3; sx = -yy; sy = zz; sz = -xx - - ELSEIF ((iy == 1) .AND. (ix /= -1)) THEN - ipanel = 2; sx = -xx; sy = zz; sz = yy - - ELSEIF ((iy == -1) .AND. (ix /= 1)) THEN - ipanel = 4; sx = xx; sy = zz; sz = -yy - - ELSE - WRITE(*,*) 'Fatal Error: CubedSphereABPFromRLL failed' - WRITE(*,*) '(xx, yy, zz) = (', xx, ',', yy, ',', zz, ')' - WRITE(*,*) 'pm =', pm, ' (ix, iy, iz) = (', ix, ',', iy, ',', iz, ')' - STOP - ENDIF - - ! Use panel information to calculate (alpha, beta) coords - alpha = ATAN(sx / sz) - beta = ATAN(sy / sz) - -END SUBROUTINE CubedSphereABPFromRLL - - - -! -! write netCDF file -! -subroutine wrt_cube(ncube,terr_cube,landfrac_cube,landm_coslat_cube,sgh30_cube) - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none -# include - - ! - ! Dummy arguments - ! - integer, intent(in) :: ncube - real (r8), dimension(6*ncube*ncube), intent(in) :: terr_cube,landfrac_cube,sgh30_cube,landm_coslat_cube - ! - ! Local variables - ! - !----------------------------------------------------------------------- - ! - ! grid coordinates and masks - ! - !----------------------------------------------------------------------- - - real (r8), dimension(6*ncube*ncube) :: grid_center_lat ! lat/lon coordinates for - real (r8), dimension(6*ncube*ncube) :: grid_center_lon ! each grid center in degrees - - integer :: ncstat ! general netCDF status variable - integer :: nc_grid_id ! netCDF grid dataset id - integer :: nc_gridsize_id ! netCDF grid size dim id - integer :: nc_gridrank_id ! netCDF grid rank dim id - integer :: nc_griddims_id ! netCDF grid dimension size id - integer :: nc_grdcntrlat_id ! netCDF grid center lat id - integer :: nc_grdcntrlon_id ! netCDF grid center lon id - integer :: nc_terr_id - integer :: nc_landfrac_id - integer :: nc_landm_coslat_id - integer :: nc_var_id - - - integer, dimension(2) :: nc_dims2_id ! netCDF dim id array for 2-d arrays - integer :: grid_dims - - character(18), parameter :: grid_file_out = 'USGS-topo-cube.nc' - character(90), parameter :: grid_name = 'equi-angular gnomonic cubed sphere grid' - - character (len=32) :: fout ! NetCDF output file - integer :: foutid ! Output file id - integer :: lonid, lonvid - integer :: latid, latvid - integer :: status ! return value for error control of netcdf routin - integer :: i,j,k - character (len=8) :: datestring - - integer :: atm_add,n - real(r8) :: xgno_ce,lon,ygno_ce,lat - - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - REAL (r8), PARAMETER :: rad2deg = 180.0/pi - - real(r8) :: da, a1,a2,a3,a4,dbg_area,max_size - real(r8), dimension(2,2) :: ang - real(r8) :: tmp_lon,min_lon,max_lon!,sum,lflag_value - logical :: lflag - - grid_dims = 6*ncube*ncube - - dbg_area = 0.0 - - da = pi / DBLE(2*ncube) - atm_add = 1 - do k=1,6 - do j=1,ncube - ygno_ce = -piq + da * (DBLE(j-1)+0.5) !center of cell - do i=1,ncube - xgno_ce = -piq + da * (DBLE(i-1)+0.5) - call CubedSphereRLLFromABP(xgno_ce, ygno_ce, k, lon, lat) - grid_center_lon(atm_add ) = lon*rad2deg - grid_center_lat(atm_add ) = lat*rad2deg - atm_add = atm_add+1 - end do - end do - end do - - WRITE(*,*) "Create NetCDF file for output" - ncstat = nf_create (grid_file_out, NF_64BIT_OFFSET,nc_grid_id) - call handle_err(ncstat) - - ncstat = nf_put_att_text (nc_grid_id, NF_GLOBAL, 'title',len_trim(grid_name), grid_name) - call handle_err(ncstat) - - WRITE(*,*) "define grid size dimension" - ncstat = nf_def_dim (nc_grid_id, 'grid_size', 6*ncube*ncube, nc_gridsize_id) - call handle_err(ncstat) - - WRITE(*,*) "define grid rank dimension" - ncstat = nf_def_dim (nc_grid_id, 'grid_rank', 1, nc_gridrank_id) - call handle_err(ncstat) - - WRITE(*,*) "define grid dimension size array" - ncstat = nf_def_var (nc_grid_id, 'grid_dims', NF_INT,1, nc_gridrank_id, nc_griddims_id) - call handle_err(ncstat) - - WRITE(*,*) "define grid center latitude array" - ncstat = nf_def_var (nc_grid_id, 'lat', NF_DOUBLE,1, nc_gridsize_id, nc_grdcntrlat_id) - call handle_err(ncstat) - ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlat_id, 'units',13, 'degrees_north') - call handle_err(ncstat) - - WRITE(*,*) "define grid center longitude array" - ncstat = nf_def_var (nc_grid_id, 'lon', NF_DOUBLE,1, nc_gridsize_id, nc_grdcntrlon_id) - call handle_err(ncstat) - ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlon_id, 'units',12, 'degrees_east') - call handle_err(ncstat) - - WRITE(*,*) "define terr_cube array" - ncstat = nf_def_var (nc_grid_id, 'terr', NF_DOUBLE,1, nc_gridsize_id, nc_terr_id) - call handle_err(ncstat) - ncstat = nf_put_att_text (nc_grid_id, nc_terr_id, 'units',1, 'm') - call handle_err(ncstat) - - WRITE(*,*) "define landfrac_cube array" - ncstat = nf_def_var (nc_grid_id, 'LANDFRAC', NF_DOUBLE,1, nc_gridsize_id, nc_landfrac_id) - call handle_err(ncstat) - ncstat = nf_put_att_text (nc_grid_id, nc_landfrac_id, 'long_name',70,& - 'land ocean transition mask: ocean (0), continent (1), transition (0-1)') - call handle_err(ncstat) - - WRITE(*,*) "define landm_coslat_cube array" - ncstat = nf_def_var (nc_grid_id, 'LANDM_COSLAT', NF_DOUBLE,1, nc_gridsize_id, nc_landm_coslat_id) - call handle_err(ncstat) - ncstat = nf_put_att_text (nc_grid_id, nc_landm_coslat_id, 'long_name',35,'smoothed land ocean transition mask') - call handle_err(ncstat) - - WRITE(*,*) "define sgh30_cube array" - ncstat = nf_def_var (nc_grid_id, 'SGH30', NF_DOUBLE,1, nc_gridsize_id, nc_var_id) - call handle_err(ncstat) - ncstat = nf_put_att_text (nc_grid_id, nc_var_id, 'units',12, 'm') - call handle_err(ncstat) - ncstat = nf_put_att_text (nc_grid_id, nc_var_id, 'long_name',58,& - 'variance of elevation from 30s lat-lon to 3km cubed-sphere') - - WRITE(*,*) "end definition stage" - ncstat = nf_enddef(nc_grid_id) - call handle_err(ncstat) - - !----------------------------------------------------------------------- - ! - ! write grid data - ! - !----------------------------------------------------------------------- - - - WRITE(*,*) "write grid data" - ncstat = nf_put_var_int(nc_grid_id, nc_griddims_id, grid_dims) - call handle_err(ncstat) - - ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlat_id, grid_center_lat) - call handle_err(ncstat) - - ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlon_id, grid_center_lon) - call handle_err(ncstat) - - ncstat = nf_put_var_double(nc_grid_id, nc_terr_id, terr_cube) - call handle_err(ncstat) - - ncstat = nf_put_var_double(nc_grid_id, nc_landfrac_id, landfrac_cube) - call handle_err(ncstat) - - ncstat = nf_put_var_double(nc_grid_id, nc_landm_coslat_id, landm_coslat_cube) - call handle_err(ncstat) - - ncstat = nf_put_var_double(nc_grid_id, nc_var_id, sgh30_cube) - call handle_err(ncstat) - - WRITE(*,*) "Close output file" - ncstat = nf_close(nc_grid_id) - call handle_err(ncstat) -end subroutine wrt_cube - - -!------------------------------------------------------------------------------ -! SUBROUTINE EquiangularAllAreas -! -! Description: -! Compute the area of all cubed sphere grid cells, storing the results in -! a two dimensional array. -! -! Parameters: -! icube - Resolution of the cubed sphere -! dA (OUT) - Output array containing the area of all cubed sphere grid cells -!------------------------------------------------------------------------------ -SUBROUTINE EquiangularAllAreas(icube, dA) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - - INTEGER, INTENT(IN) :: icube - REAL (r8), DIMENSION(icube,icube), INTENT(OUT) :: dA - - ! Local variables - INTEGER :: k, k1, k2 - REAL (r8) :: a1, a2, a3, a4 - REAL (r8), DIMENSION(icube+1,icube+1) :: ang - REAL (r8), DIMENSION(icube+1) :: gp - - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - - - !#ifdef DBG - REAL (r8) :: dbg1 !DBG - !#endif - - ! Recall that we are using equi-angular spherical gridding - ! Compute the angle between equiangular cubed sphere projection grid lines. - DO k = 1, icube+1 - gp(k) = -piq + (pi/DBLE(2*(icube))) * DBLE(k-1) - ENDDO - - DO k2=1,icube+1 - DO k1=1,icube+1 - ang(k1,k2) =ACOS(-SIN(gp(k1)) * SIN(gp(k2))) - ENDDO - ENDDO - - DO k2=1,icube - DO k1=1,icube - a1 = ang(k1 , k2 ) - a2 = pi - ang(k1+1, k2 ) - a3 = pi - ang(k1 , k2+1) - a4 = ang(k1+1, k2+1) - - ! area = r*r*(-2*pi+sum(interior angles)) - DA(k1,k2) = -2.0*pi+a1+a2+a3+a4 - ENDDO - ENDDO - - !#ifdef DBG - ! Only for debugging - test consistency - dbg1 = 0.0 !DBG - DO k2=1,icube - DO k1=1,icube - dbg1 = dbg1 + DA(k1,k2) !DBG - ENDDO - ENDDO - write(*,*) 'DAcube consistency: ',dbg1-4.0*pi/6.0 !DBG - !#endif -END SUBROUTINE EquiangularAllAreas - - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereRLLFromABP -! -! Description: -! Determine the lat lon coordinate of a point on a sphere given its -! (alpha,beta,panel) coordinate. -! -! Parameters: -! alpha - Alpha coordinate -! beta - Beta coordinate -! panel - Cubed sphere panel id -! lon (OUT) - Calculated longitude -! lat (OUT) - Calculated latitude -!------------------------------------------------------------------------------ -SUBROUTINE CubedSphereRLLFromABP(alpha, beta, ipanel, lon, lat) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - REAL (r8), INTENT(IN) :: alpha, beta - INTEGER , INTENT(IN) :: ipanel - REAL (r8), INTENT(OUT) :: lon, lat - ! Local variables - REAL (r8) :: xx, yy, zz, rotate_cube - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - - rotate_cube = 0.0 - ! Convert to cartesian coordinates - CALL CubedSphereXYZFromABP(alpha, beta, ipanel, xx, yy, zz) - ! Convert back to lat lon - lat = ASIN(zz) - if (xx==0.0.and.yy==0.0) THEN - lon = 0.0 - else - lon = ATAN2(yy, xx) +rotate_cube - IF (lon<0.0) lon=lon+2.0*pi - IF (lon>2.0*pi) lon=lon-2.0*pi - end if -END SUBROUTINE CubedSphereRLLFromABP - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereXYZFromABP -! -! Description: -! Determine the Cartesian coordinate of a point on a sphere given its -! (alpha,beta,panel) coordinate. -! -! Parameters: -! alpha - Alpha coordinate -! beta - Beta coordinate -! panel - Cubed sphere panel id -! xx (OUT) - Calculated x coordinate -! yy (OUT) - Calculated y coordinate -! zz (OUT) - Calculated z coordinate -!------------------------------------------------------------------------------ -SUBROUTINE CubedSphereXYZFromABP(alpha, beta, ipanel, xx, yy, zz) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - - REAL (r8), INTENT(IN) :: alpha, beta - INTEGER , INTENT(IN) :: ipanel - REAL (r8), INTENT(OUT) :: xx, yy, zz - ! Local variables - REAL (r8) :: a1, b1, pm - REAL (r8) :: sx, sy, sz - - ! Convert to Cartesian coordinates - a1 = TAN(alpha) - b1 = TAN(beta) - - sz = (1.0 + a1 * a1 + b1 * b1)**(-0.5) - sx = sz * a1 - sy = sz * b1 - ! Panel assignments - IF (ipanel == 6) THEN - yy = sx; xx = -sy; zz = sz - ELSEIF (ipanel == 5) THEN - yy = sx; xx = sy; zz = -sz - ELSEIF (ipanel == 1) THEN - yy = sx; zz = sy; xx = sz - ELSEIF (ipanel == 3) THEN - yy = -sx; zz = sy; xx = -sz - ELSEIF (ipanel == 2) THEN - xx = -sx; zz = sy; yy = sz - ELSEIF (ipanel == 4) THEN - xx = sx; zz = sy; yy = -sz - ELSE - WRITE(*,*) 'Fatal Error: Panel out of range in CubedSphereXYZFromABP' - WRITE(*,*) '(alpha, beta, panel) = (', alpha, ',', beta, ',', ipanel, ')' - STOP - ENDIF -END SUBROUTINE CubedSphereXYZFromABP - - diff --git a/tools/topo_tool/bin_to_cube/shr_kind_mod.F90 b/tools/topo_tool/bin_to_cube/shr_kind_mod.F90 deleted file mode 100644 index fc1ed8e94a..0000000000 --- a/tools/topo_tool/bin_to_cube/shr_kind_mod.F90 +++ /dev/null @@ -1,20 +0,0 @@ -!=============================================================================== -! CVS: $Id$ -! CVS: $Source$ -! CVS: $Name$ -!=============================================================================== - -MODULE shr_kind_mod - - !---------------------------------------------------------------------------- - ! precision/kind constants add data public - !---------------------------------------------------------------------------- - public - integer,parameter :: SHR_KIND_R8 = selected_real_kind(12) ! 8 byte real - integer,parameter :: SHR_KIND_R4 = selected_real_kind( 6) ! 4 byte real - integer,parameter :: SHR_KIND_RN = kind(1.0) ! native real - integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer - integer,parameter :: SHR_KIND_I4 = selected_int_kind ( 6) ! 4 byte integer - integer,parameter :: SHR_KIND_IN = kind(1) ! native integer - -END MODULE shr_kind_mod diff --git a/tools/topo_tool/cube_to_target/Makefile b/tools/topo_tool/cube_to_target/Makefile deleted file mode 100644 index 23d518cf03..0000000000 --- a/tools/topo_tool/cube_to_target/Makefile +++ /dev/null @@ -1,69 +0,0 @@ -EXEDIR = . -EXENAME = cube_to_target -RM = rm - -.SUFFIXES: -.SUFFIXES: .F90 .o - -FC = lf95 -DEBUG = FALSE - - -# Check for the NetCDF library and include directories -ifeq ($(LIB_NETCDF),$(null)) -LIB_NETCDF := /usr/local/lib -endif - -ifeq ($(INC_NETCDF),$(null)) -INC_NETCDF := /usr/local/include -endif - -# Determine platform -UNAMES := $(shell uname -s) -UNAMEM := $(findstring CRAY,$(shell uname -m)) - -#------------------------------------------------------------------------ -# LF95 -#------------------------------------------------------------------------ -# -# setenv LD_LIBRARY_PATH ${LD_LIBRARY_PATH}:/usr/local/netcdf-4.1.3-gcc-4.4.4-13-lf9581/lib -# -ifeq ($(FC),lf95) -# -# Tramhill -# - INC_NETCDF :=/usr/local/netcdf-4.1.3-gcc-4.4.4-13-lf9581/include - LIB_NETCDF :=/usr/local/netcdf-4.1.3-gcc-4.4.4-13-lf9581/lib - - LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -lnetcdff -lcurl -lhdf5 -lhdf5_hl -mcmodel=medium - FFLAGS := -c --trace --trap --wide -CcdRR8 -I$(INC_NETCDF) - ifeq ($(DEBUG),TRUE) -# FFLAGS += --chk aesu -Cpp --trace - FFLAGS += -g --chk a,e,s,u --pca - else - FFLAGS += -O - endif - -endif - - - -.F90.o: - $(FC) $(FFLAGS) $< - -#------------------------------------------------------------------------ -# Default rules and macros -#------------------------------------------------------------------------ - -OBJS := reconstruct.o remap.o cube_to_target.o shr_kind_mod.o - -$(EXEDIR)/$(EXENAME): $(OBJS) - $(FC) -o $@ $(OBJS) $(LDFLAGS) - -clean: - $(RM) -f $(OBJS) *.mod $(EXEDIR)/$(EXENAME) - -cube_to_target.o: shr_kind_mod.o remap.o reconstruct.o -remap.o: -reconstruct.o: remap.o -#reconstruct.o : shr_kind_mod.o diff --git a/tools/topo_tool/cube_to_target/README b/tools/topo_tool/cube_to_target/README deleted file mode 100644 index 134b6de4f9..0000000000 --- a/tools/topo_tool/cube_to_target/README +++ /dev/null @@ -1,20 +0,0 @@ -cube_to_target performs rigourous remapping of topo variables from cubed-sphere grid to -any target grid. In the process SGH is computed. - -Input files: - -1. USGS-topo-cube.nc (may be found here $CESMDATA/inputdata/atm/cam/hrtopo/USGS-topo-cube3000.nc) - - This is the topo data on a cubed-sphere (default is 3km cubed-sphere grid) - -2. target.nc (e.g., $CESMDATA/inputdata/atm/cam/grid-description/se/ne30np4_091226_pentagons.nc) - - This is a SCRIP/ESMF grid descriptor file for the target grid - -3. phis-smooth.nc - - (optional) The user may provide a smoothed PHIS field. The software then recomputes SGH to - account for the smoothing in the sub-grid-scale. - - - diff --git a/tools/topo_tool/cube_to_target/cube_to_target.F90 b/tools/topo_tool/cube_to_target/cube_to_target.F90 deleted file mode 100644 index 3f73f6a47b..0000000000 --- a/tools/topo_tool/cube_to_target/cube_to_target.F90 +++ /dev/null @@ -1,2008 +0,0 @@ -! -! DATE CODED: Nov 7, 2011 to Oct 15, 2012 -! DESCRIPTION: Remap topo data from cubed-sphere grid to target grid using rigorous remapping -! (Lauritzen, Nair and Ullrich, 2010, J. Comput. Phys.) -! -! Author: Peter Hjort Lauritzen (pel@ucar.edu), AMP/CGD/NESL/NCAR -! -program convterr - use shr_kind_mod, only: r8 => shr_kind_r8 - use reconstruct - implicit none -# include - - !************************************** - ! - ! USER SETTINGS BELOW - ! - !************************************** - ! - ! - ! if smoothed PHIS is available SGH needs to be recomputed to account for the sub-grid-scale - ! variability introduced by the smoothing - ! - logical :: lsmooth_terr = .FALSE. - ! - ! PHIS is smoothed by other software/dynamical core - ! - logical :: lexternal_smooth_terr = .FALSE. ! lexternal_smooth_terr = .FALSE. is NOT supported currently - ! - ! set PHIS=0.0 if LANDFRAC<0.01 - ! - logical :: lzero_out_ocean_point_phis = .FALSE. - ! - ! For internal smoothing (experimental at this point) - ! =================================================== - ! - ! if smoothing is internal (lexternal_smooth_terr=.FALSE.) choose coarsening factor - ! - ! recommendation: 2*(target resolution)/(0.03 degree) - ! - ! factor must be an even integer - ! - integer, parameter :: factor = 60 !coarse grid = 2.25 degrees - integer, parameter :: norder = 2 - integer, parameter :: nmono = 0 - integer, parameter :: npd = 1 - ! - !********************************************************************** - ! - ! END OF USER SETTINS BELOW - ! (do not edit beyond this point unless you know what you are doing!) - ! - !********************************************************************** - ! - integer :: im, jm, ncoarse - integer :: ncube !dimension of cubed-sphere grid - - real(r8), allocatable, dimension(:) :: landm_coslat, landfrac, terr, sgh30 - real(r8), allocatable, dimension(:) :: terr_coarse !for internal smoothing - - integer :: alloc_error,dealloc_error - integer :: i,j,n,k,index - integer*2, allocatable, dimension(:,:) :: iterr ! terrain data for 30-sec tile - integer ncid,status, dimlatid,dimlonid, landid, topoid ! for netCDF USGS data file - integer :: srcid,dstid, jm_dbg ! for netCDF weight file - integer, dimension(2) :: src_grid_dims ! for netCDF weight file - - integer :: dimid - - logical :: ldbg - real(r8), allocatable, dimension(:) :: lon , lat - real(r8), allocatable, dimension(:) :: lon_landm , lat_landm - real(r8), allocatable, dimension(:) :: area - integer :: im_landm, jm_landm - integer :: lonid, latid, phisid - ! - ! constants - ! - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - REAL (r8), PARAMETER :: pih = 0.50*pi - REAL (r8), PARAMETER :: deg2rad = pi/180.0 - - real(r8) :: wt,dlat - integer :: ipanel,icube,jcube - real(r8), allocatable, dimension(:,:,:) :: weight,terr_cube,landfrac_cube,sgh30_cube - real(r8), allocatable, dimension(:,:,:) :: landm_coslat_cube - integer, allocatable, dimension(:,:) :: idx,idy,idp - integer :: npatch, isub,jsub, itmp, iplm1,jmin,jmax - real(r8) :: sum,dx,scale,dmax,arad,jof,term,s1,c1,clon,iof,dy,s2,c2,dist - ! - ! for linear interpolation - ! - real(r8) :: lambda,theta,wx,wy,offset - integer :: ilon,ilat,ip1,jp1 - ! - ! variable for regridding - ! - integer :: src_grid_dim ! for netCDF weight file - integer :: n_a,n_b,n_s,n_aid,n_bid,n_sid - integer :: count - real(r8), allocatable, dimension(:) :: landfrac_target, terr_target, sgh30_target, sgh_target - real(r8), allocatable, dimension(:) :: landm_coslat_target, area_target - ! - ! this is only used if target grid is a lat-lon grid - ! - integer , parameter :: im_target = 360 , jm_target = 180 - ! - ! this is only used if target grid is not a lat-lon grid - ! - real(r8), allocatable, dimension(:) :: lon_target, lat_target - ! - ! new - ! - integer :: ntarget, ntarget_id, ncorner, ncorner_id, nrank, nrank_id - integer :: ntarget_smooth - real(r8), allocatable, dimension(:,:):: target_corner_lon, target_corner_lat - real(r8), allocatable, dimension(:) :: target_center_lon, target_center_lat, target_area - integer :: ii,ip,jx,jy,jp - real(r8), dimension(:), allocatable :: xcell, ycell, xgno, ygno - real(r8), dimension(:), allocatable :: gauss_weights,abscissae - integer, parameter :: ngauss = 3 - integer :: jmax_segments,jall - real(r8) :: tmp - - real(r8), allocatable, dimension(:,:) :: weights_all - integer , allocatable, dimension(:,:) :: weights_eul_index_all - integer , allocatable, dimension(:) :: weights_lgr_index_all - integer :: ix,iy - ! - ! volume of topography - ! - real(r8) :: vol_target, vol_target_un, area_target_total,vol_source,vol_tmp - integer :: nlon,nlon_smooth,nlat,nlat_smooth - logical :: ltarget_latlon,lpole - real(r8), allocatable, dimension(:,:) :: terr_smooth - ! - ! for internal filtering - ! - real(r8), allocatable, dimension(:,:) :: weights_all_coarse - integer , allocatable, dimension(:,:) :: weights_eul_index_all_coarse - integer , allocatable, dimension(:) :: weights_lgr_index_all_coarse - real(r8), allocatable, dimension(:) :: area_target_coarse - real(r8), allocatable, dimension(:,:) :: da_coarse,da - real(r8), allocatable, dimension(:,:) :: recons,centroids - integer :: nreconstruction - - integer :: jmax_segments_coarse,jall_coarse,ncube_coarse - real(r8) :: all_weights - - ! - ! turn extra debugging on/off - ! - ldbg = .FALSE. - - nreconstruction = 1 - ! - !********************************************************* - ! - ! read in target grid - ! - !********************************************************* - ! - status = nf_open('target.nc', 0, ncid) - IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) - - status = NF_INQ_DIMID(ncid, 'grid_size', ntarget_id) - status = NF_INQ_DIMLEN(ncid, ntarget_id, ntarget) - WRITE(*,*) "dimension of target grid: ntarget=",ntarget - - status = NF_INQ_DIMID(ncid, 'grid_corners', ncorner_id) - status = NF_INQ_DIMLEN(ncid, ncorner_id, ncorner) - WRITE(*,*) "maximum number of corners: ncorner=",ncorner - - status = NF_INQ_DIMID(ncid, 'grid_rank', nrank_id);status = NF_INQ_DIMLEN(ncid, nrank_id, nrank) - WRITE(*,*) "grid rank: nrank=",nrank - IF (nrank==2) THEN - WRITE(*,*) "target grid is a lat-lon grid" - ltarget_latlon = .TRUE. - status = NF_INQ_DIMID(ncid, 'nlon', ntarget_id) - status = NF_INQ_DIMLEN(ncid, ntarget_id, nlon) - status = NF_INQ_DIMID(ncid, 'nlat', ntarget_id) - status = NF_INQ_DIMLEN(ncid, ntarget_id, nlat) - status = NF_INQ_DIMID(ncid, 'lpole', ntarget_id) - status = NF_INQ_DIMLEN(ncid, ntarget_id, lpole) - WRITE(*,*) "nlon=",nlon,"nlat=",nlat - IF (lpole) THEN - WRITE(*,*) "center of most Northern grid cell is lat=90; similarly for South pole" - ELSE - WRITE(*,*) "center of most Northern grid cell is NOT lat=90; similarly for South pole" - END IF - ELSE IF (nrank==1) THEN - ltarget_latlon = .FALSE. - ELSE - WRITE(*,*) "nrank out of range",nrank - STOP - ENDIF - - allocate ( target_corner_lon(ncorner,ntarget),stat=alloc_error) - allocate ( target_corner_lat(ncorner,ntarget),stat=alloc_error) - - status = NF_INQ_VARID(ncid, 'grid_corner_lon', lonid) - status = NF_GET_VAR_DOUBLE(ncid, lonid,target_corner_lon) - IF (maxval(target_corner_lon)>10.0) target_corner_lon = deg2rad*target_corner_lon - - status = NF_INQ_VARID(ncid, 'grid_corner_lat', latid) - status = NF_GET_VAR_DOUBLE(ncid, latid,target_corner_lat) - IF (maxval(target_corner_lat)>10.0) target_corner_lat = deg2rad*target_corner_lat - ! - ! for writing remapped data on file at the end of the program - ! - allocate ( target_center_lon(ntarget),stat=alloc_error) - allocate ( target_center_lat(ntarget),stat=alloc_error) - allocate ( target_area (ntarget),stat=alloc_error)!dbg - - status = NF_INQ_VARID(ncid, 'grid_center_lon', lonid) - status = NF_GET_VAR_DOUBLE(ncid, lonid,target_center_lon) - - status = NF_INQ_VARID(ncid, 'grid_center_lat', latid) - status = NF_GET_VAR_DOUBLE(ncid, latid,target_center_lat) - - status = NF_INQ_VARID(ncid, 'grid_area', latid) - status = NF_GET_VAR_DOUBLE(ncid, latid,target_area) - - status = nf_close (ncid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - !**************************************************** - ! - ! get dimension of cubed-sphere grid - ! - !**************************************************** - ! - WRITE(*,*) "get dimension of cubed-sphere data from file" - status = nf_open('USGS-topo-cube.nc', 0, ncid) - IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) - - status = NF_INQ_DIMID(ncid, 'grid_size', dimid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - status = NF_INQ_DIMLEN(ncid, dimid, n) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - ncube = INT(SQRT(DBLE(n/6))) - WRITE(*,*) "cubed-sphere dimension: ncube = ",ncube - WRITE(*,*) "average grid-spacing at the Equator (degrees):" ,90.0/ncube - - status = nf_close (ncid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - !**************************************************** - ! - ! compute weights for remapping - ! - !**************************************************** - ! - jall = ncube*ncube*12*10 !anticipated number of weights (cab be tweaked) - jmax_segments = 100000 !can be tweaked - - allocate (weights_all(jall,nreconstruction),stat=alloc_error ) - allocate (weights_eul_index_all(jall,3),stat=alloc_error ) - allocate (weights_lgr_index_all(jall),stat=alloc_error ) - - CALL overlap_weights(weights_lgr_index_all,weights_eul_index_all,weights_all,& - jall,ncube,ngauss,ntarget,ncorner,jmax_segments,target_corner_lon,target_corner_lat,nreconstruction) - ! - !**************************************************** - ! - ! read cubed-sphere 3km data - ! - !**************************************************** - ! - WRITE(*,*) "read cubed-sphere 3km data from file" - status = nf_open('USGS-topo-cube.nc', 0, ncid) - IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) - - status = NF_INQ_DIMID(ncid, 'grid_size', dimid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - status = NF_INQ_DIMLEN(ncid, dimid, n) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - ncube = INT(SQRT(DBLE(n/6))) - WRITE(*,*) "cubed-sphere dimension, ncube: ",ncube - - allocate ( landm_coslat(n),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - status = NF_INQ_VARID(ncid, 'LANDM_COSLAT', landid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_GET_VAR_DOUBLE(ncid, landid,landm_coslat) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - WRITE(*,*) "min/max of landm_coslat",MINVAL(landm_coslat),MAXVAL(landm_coslat) - ! - ! read LANDFRAC - ! - allocate ( landfrac(n),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - status = NF_INQ_VARID(ncid, 'LANDFRAC', landid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_GET_VAR_DOUBLE(ncid, landid,landfrac) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - WRITE(*,*) "min/max of landfrac",MINVAL(landfrac),MAXVAL(landfrac) - ! - ! read terr - ! - allocate ( terr(n),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - status = NF_INQ_VARID(ncid, 'terr', landid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_GET_VAR_DOUBLE(ncid, landid,terr) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - WRITE(*,*) "min/max of terr",MINVAL(terr),MAXVAL(terr) - ! - ! - ! - allocate ( sgh30(n),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - status = NF_INQ_VARID(ncid, 'SGH30', landid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_GET_VAR_DOUBLE(ncid, landid,sgh30) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - WRITE(*,*) "min/max of sgh30",MINVAL(sgh30),MAXVAL(sgh30) - print *,"close file" - status = nf_close (ncid) - if (status .ne. NF_NOERR) call handle_err(status) - - WRITE(*,*) 'done reading in LANDM_COSLAT data from netCDF file' - ! - !********************************************************* - ! - ! do actual remapping - ! - !********************************************************* - ! - allocate (terr_target(ntarget),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for terr_target' - stop - end if - allocate (landfrac_target(ntarget),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac_target' - stop - end if - allocate (landm_coslat_target(ntarget),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac_target' - stop - end if - allocate (sgh30_target(ntarget),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for sgh30_target' - stop - end if - allocate (area_target(ntarget),stat=alloc_error ) - terr_target = 0.0 - landfrac_target = 0.0 - sgh30_target = 0.0 - landm_coslat_target = 0.0 - area_target = 0.0 - - tmp = 0.0 - do count=1,jall - i = weights_lgr_index_all(count) - wt = weights_all(count,1) - area_target (i) = area_target(i) + wt - end do - - do count=1,jall - i = weights_lgr_index_all(count) - - ix = weights_eul_index_all(count,1) - iy = weights_eul_index_all(count,2) - ip = weights_eul_index_all(count,3) - ! - ! convert to 1D indexing of cubed-sphere - ! - ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix - - wt = weights_all(count,1) - - terr_target (i) = terr_target (i) + wt*terr (ii)/area_target(i) - landfrac_target (i) = landfrac_target (i) + wt*landfrac (ii)/area_target(i) - landm_coslat_target(i) = landm_coslat_target(i) + wt*landm_coslat(ii)/area_target(i) - sgh30_target (i) = sgh30_target (i) + wt*sgh30 (ii)/area_target(i) - - tmp = tmp+wt*terr(ii) - end do - - - write(*,*) "tmp", tmp - WRITE(*,*) "max difference between target grid area and remapping software area",& - MAXVAL(target_area-area_target) - - do count=1,ntarget - if (terr_target(count)>8848.0) then - ! - ! max height is higher than Mount Everest - ! - write(*,*) "FATAL error: max height is higher than Mount Everest!" - write(*,*) "terr_target",count,terr_target(count) - write(*,*) "(lon,lat) locations of vertices of cell with excessive max height::" - do i=1,ncorner - write(*,*) target_corner_lon(i,count),target_corner_lat(i,count) - end do - STOP - else if (terr_target(count)<-423.0) then - ! - ! min height is lower than Dead Sea - ! - write(*,*) "FATAL error: min height is lower than Dead Sea!" - write(*,*) "terr_target",count,terr_target(count) - write(*,*) "(lon,lat) locations of vertices of cell with excessive min height::" - do i=1,ncorner - write(*,*) target_corner_lon(i,count),target_corner_lat(i,count) - end do - STOP - else - - end if - end do - WRITE(*,*) "Elevation data passed min/max consistency check!" - WRITE(*,*) - - WRITE(*,*) "min/max of unsmoothed terr_target : ",MINVAL(terr_target ),MAXVAL(terr_target ) - WRITE(*,*) "min/max of landfrac_target : ",MINVAL(landfrac_target),MAXVAL(landfrac_target) - WRITE(*,*) "min/max of landm_coslat_target : ",& - MINVAL(landm_coslat_target),MAXVAL(landm_coslat_target) - WRITE(*,*) "min/max of var30_target : ",MINVAL(sgh30_target ),MAXVAL(sgh30_target ) - ! - ! compute mean height (globally) of topography about sea-level for target grid unfiltered elevation - ! - vol_target_un = 0.0 - area_target_total = 0.0 - DO i=1,ntarget - area_target_total = area_target_total+area_target(i) - vol_target_un = vol_target_un+terr_target(i)*area_target(i) - END DO - WRITE(*,*) "mean height (globally) of topography about sea-level for target grid unfiltered elevation",& - vol_target_un/area_target_total - - ! - ! diagnostics - ! - vol_source = 0.0 - allocate ( dA(ncube,ncube),stat=alloc_error ) - CALL EquiangularAllAreas(ncube, dA) - DO jp=1,6 - DO jy=1,ncube - DO jx=1,ncube - ii = (jp-1)*ncube*ncube+(jy-1)*ncube+jx - vol_source = vol_source+terr(ii)*dA(jx,jy) - END DO - END DO - END DO - WRITE(*,*) "volume of input cubed-sphere terrain :",vol_source - WRITE(*,*) "average elevation of input cubed-sphere terrain:",vol_source/(4.0*pi) - - DEALLOCATE(dA) - ! - ! - ! - allocate (sgh_target(ntarget),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for sgh_target' - stop - end if - ! - ! compute variance with respect to cubed-sphere data - ! - WRITE(*,*) "compute variance with respect to 3km cubed-sphere data: SGH" - - IF (lsmooth_terr) THEN - WRITE(*,*) "smoothing PHIS" - IF (lexternal_smooth_terr) THEN - WRITE(*,*) "using externally generated smoothed topography" - - status = nf_open('phis-smooth.nc', 0, ncid) - IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) - ! - IF (.NOT.ltarget_latlon) THEN - ! - !********************************************************* - ! - ! read in smoothed topography - ! - !********************************************************* - ! - status = NF_INQ_DIMID (ncid, 'ncol', ntarget_id ) - status = NF_INQ_DIMLEN(ncid, ntarget_id , ntarget_smooth) - IF (ntarget.NE.ntarget_smooth) THEN - WRITE(*,*) "mismatch in smoothed data-set and target grid specification" - WRITE(*,*) ntarget, ntarget_smooth - STOP - END IF - status = NF_INQ_VARID(ncid, 'PHIS', phisid) - ! - ! overwrite terr_target with smoothed version - ! - status = NF_GET_VAR_DOUBLE(ncid, phisid,terr_target) - terr_target = terr_target/9.80616 - ELSE - ! - ! read in smoothed lat-lon topography - ! - status = NF_INQ_DIMID(ncid, 'lon', ntarget_id) - status = NF_INQ_DIMLEN(ncid, ntarget_id, nlon_smooth) - status = NF_INQ_DIMID(ncid, 'lat', ntarget_id) - status = NF_INQ_DIMLEN(ncid, ntarget_id, nlat_smooth) - IF (nlon.NE.nlon_smooth.OR.nlat.NE.nlat_smooth) THEN - WRITE(*,*) "smoothed topography dimensions do not match target grid dimensions" - WRITE(*,*) "target grid : nlon ,nlat =",nlon,nlat - WRITE(*,*) "smoothed topo: nlon_smooth,nlat_smooth =",nlon_smooth,nlat_smooth - STOP - END IF - ALLOCATE(terr_smooth(nlon_smooth,nlat_smooth),stat=alloc_error) - status = NF_INQ_VARID(ncid, 'PHIS', phisid) - status = NF_GET_VAR_DOUBLE(ncid, phisid,terr_smooth) - ! - ! overwrite terr_target with smoothed version - ! - ii=1 - DO j=1,nlat - DO i=1,nlon - terr_target(ii) = terr_smooth(i,j)/9.80616 - ii=ii+1 - END DO - END DO - DEALLOCATE(terr_smooth) - END IF - ELSE - WRITE(*,*) "unstested software - uncomment this line of you know what you are doing!" - STOP - ! - !***************************************************** - ! - ! smoothing topography internally - ! - !***************************************************** - ! - WRITE(*,*) "internally smoothing orography" - ! CALL smooth(terr_target,ntarget,target_corner_lon,target_corner_lat) - ! - ! smooth topography internally - ! - ncoarse = n/(factor*factor) - ! - ! - ! - ncube_coarse = ncube/factor - WRITE(*,*) "resolution of coarse grid", 90.0/ncube_coarse - allocate ( terr_coarse(ncoarse),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - WRITE(*,*) "coarsening" - allocate ( dA_coarse(ncube_coarse,ncube_coarse),stat=alloc_error ) - CALL coarsen(terr,terr_coarse,factor,n,dA_coarse) - ! - ! - ! - vol_tmp = 0.0 - DO jp=1,6 - DO jy=1,ncube_coarse - DO jx=1,ncube_coarse - ii = (jp-1)*ncube_coarse*ncube_coarse+(jy-1)*ncube_coarse+jx - vol_tmp = vol_tmp+terr_coarse(ii)*dA_coarse(jx,jy) - END DO - END DO - END DO - WRITE(*,*) "volume of coarsened cubed-sphere terrain :",vol_source - WRITE(*,*) "difference between coarsened cubed-sphere data and input cubed-sphere data",& - vol_tmp-vol_source - - - - WRITE(*,*) "done coarsening" - - nreconstruction = 1 - IF (norder>1) THEN - IF (norder == 2) THEN - nreconstruction = 3 - ELSEIF (norder == 3) THEN - nreconstruction = 6 - END IF - ALLOCATE(recons (nreconstruction, ncoarse), STAT=status) - ALLOCATE(centroids(nreconstruction, ncoarse), STAT=status) - CALL get_reconstruction(terr_coarse,norder, nmono, recons, npd,da_coarse,& - ncube_coarse+1,nreconstruction,centroids) - SELECT CASE (nmono) - CASE (0) - WRITE(*,*) "coarse grid reconstructions are not filtered with shape-preesrving filter" - CASE (1) - WRITE(*,*) "coarse grid reconstructions are filtered with shape-preserving filter" - CASE DEFAULT - WRITE(*,*) "nmono out of range: ",nmono - STOP - END SELECT - SELECT CASE (0) - CASE (0) - WRITE(*,*) "coarse grid reconstructions are not filtered with positive definite filter" - CASE (1) - WRITE(*,*) "coarse grid reconstructions filtered with positive definite filter" - CASE DEFAULT - WRITE(*,*) "npd out of range: ",npd - STOP - END SELECT - END IF - - jall_coarse = (ncube*ncube*12) !anticipated number of weights - jmax_segments_coarse = jmax_segments!/factor ! - WRITE(*,*) "anticipated",jall_coarse - allocate (weights_all_coarse(jall_coarse,nreconstruction),stat=alloc_error ) - allocate (weights_eul_index_all_coarse(jall_coarse,3),stat=alloc_error ) - allocate (weights_lgr_index_all_coarse(jall_coarse),stat=alloc_error ) - ! - ! - ! - CALL overlap_weights(weights_lgr_index_all_coarse,weights_eul_index_all_coarse,weights_all_coarse,& - jall_coarse,ncube_coarse,ngauss,ntarget,ncorner,jmax_segments_coarse,target_corner_lon,& - target_corner_lat,nreconstruction) - WRITE(*,*) "MIN/MAX of area-weight [0:1]: ",& - MINVAL(weights_all_coarse(:,1)),MAXVAL(weights_all_coarse(:,1)) - ! - ! compute new weights - ! - - ! - ! do mapping - ! - terr_target = 0.0 - tmp = 0.0 - allocate ( area_target_coarse(ntarget),stat=alloc_error) - all_weights = 0.0 - area_target_coarse = 0.0 - do count=1,jall_coarse - i = weights_lgr_index_all_coarse(count) - wt = weights_all_coarse(count,1) - area_target_coarse (i) = area_target_coarse(i) + wt - all_weights = all_weights+wt - end do - WRITE(*,*) "sum of all weights (coarse to target) minus area of sphere : ",all_weights-4.0*pi - WRITE(*,*) "MIN/MAX of area_target_coarse [0:1]:",& - MINVAL(area_target_coarse),MAXVAL(area_target_coarse) - IF (norder==1) THEN - do count=1,jall_coarse - i = weights_lgr_index_all_coarse(count) - - ix = weights_eul_index_all_coarse(count,1) - iy = weights_eul_index_all_coarse(count,2) - ip = weights_eul_index_all_coarse(count,3) - ! - ! convert to 1D indexing of cubed-sphere - ! - ii = (ip-1)*ncube_coarse*ncube_coarse+(iy-1)*ncube_coarse+ix - - wt = weights_all_coarse(count,1) - - terr_target(i) = terr_target(i) + wt*terr_coarse(ii)/area_target_coarse(i) - tmp = tmp+wt*terr_coarse(ii) - end do - ELSE IF (norder==2) THEN - do count=1,jall_coarse - i = weights_lgr_index_all_coarse(count) - IF (i>jall_coarse.OR.i<1) THEN - WRITE(*,*) i,jall_coarse - STOP - END IF - ix = weights_eul_index_all_coarse(count,1) - iy = weights_eul_index_all_coarse(count,2) - ip = weights_eul_index_all_coarse(count,3) - ! - ! convert to 1D indexing of cubed-sphere - ! - ii = (ip-1)*ncube_coarse*ncube_coarse+(iy-1)*ncube_coarse+ix - - terr_target(i) = terr_target(i) + (weights_all_coarse(count,1)*(& - ! - ! all constant terms - ! - terr_coarse(ii) & - - recons(1,ii)*centroids(1,ii) & - - recons(2,ii)*centroids(2,ii) & - ! - ! + recons(3,ii)*(2.0*centroids(1,ii)**2-centroids(3,ii))& - ! + recons(4,ii)*(2.0*centroids(2,ii)**2-centroids(4,ii))& - ! - ! + recons(5,ii)*(2.0*centroids(1,ii)*centroids(2,ii)-centroids(5,ii))& - )+& - ! - ! linear terms - ! - weights_all_coarse(count,2)*(& - - recons(1,ii)& - - ! - recons(3,ii)*2.0*centroids(1,ii)& - ! - recons(5,ii)* centroids(2,ii)& - )+& - ! - weights_all_coarse(count,3)*(& - recons(2,ii)& - ! - ! - recons(4,ii)*2.0*centroids(2,ii)& - ! - recons(5,ii)* centroids(1,ii)& - )& - ! - ! quadratic terms - ! - ! weights_all_coarse(count,4)*recons(3,ii)+& - ! weights_all_coarse(count,5)*recons(4,ii)+& - ! weights_all_coarse(count,6)*recons(5,ii) - )/area_target_coarse(i) - end do - DEALLOCATE(centroids) - DEALLOCATE(recons) - DEALLOCATE(weights_all_coarse) - - ELSE IF (norder==3) THEN - ! recons(4,:) = 0.0 - ! recons(5,:) = 0.0 - do count=1,jall_coarse - i = weights_lgr_index_all_coarse(count) - IF (i>jall_coarse.OR.i<1) THEN - WRITE(*,*) i,jall_coarse - STOP - END IF - ix = weights_eul_index_all_coarse(count,1) - iy = weights_eul_index_all_coarse(count,2) - ip = weights_eul_index_all_coarse(count,3) - ! - ! convert to 1D indexing of cubed-sphere - ! - ii = (ip-1)*ncube_coarse*ncube_coarse+(iy-1)*ncube_coarse+ix - - ! terr_target(i) = terr_target(i) + wt*terr_coarse(ii)/area_target_coarse(i) - - ! WRITE(*,*) count,area_target_coarse(i) - ! terr_target(i) = terr_target(i) + area_target_coarse(i) - ! - terr_target(i) = terr_target(i) + (weights_all_coarse(count,1)*(& - - - ! centroids(5,ii))/area_target_coarse(i)) - ! centroids(1,ii)/area_target_coarse(i)) - ! /area_target_coarse(i)) - - - - - ! - ! all constant terms - ! - terr_coarse(ii) & - - recons(1,ii)*centroids(1,ii) & - - recons(2,ii)*centroids(2,ii) & - ! - + recons(3,ii)*(2.0*centroids(1,ii)**2-centroids(3,ii))& - + recons(4,ii)*(2.0*centroids(2,ii)**2-centroids(4,ii))& - ! - + recons(5,ii)*(2.0*centroids(1,ii)*centroids(2,ii)-centroids(5,ii))& - )+& - ! - ! linear terms - ! - weights_all_coarse(count,2)*(& - - recons(1,ii)& - - - recons(3,ii)*2.0*centroids(1,ii)& - - recons(5,ii)* centroids(2,ii)& - )+& - ! - weights_all_coarse(count,3)*(& - recons(2,ii)& - ! - - recons(4,ii)*2.0*centroids(2,ii)& - - recons(5,ii)* centroids(1,ii)& - )+& - ! - ! quadratic terms - ! - weights_all_coarse(count,4)*recons(3,ii)+& - weights_all_coarse(count,5)*recons(4,ii)+& - weights_all_coarse(count,6)*recons(5,ii))/area_target_coarse(i) - end do - DEALLOCATE(centroids) - DEALLOCATE(recons) - DEALLOCATE(weights_all_coarse) - END IF - DEALLOCATE(area_target_coarse) - WRITE(*,*) "done smoothing" - END IF - ! - ! compute mean height (globally) of topography about sea-level for target grid filtered elevation - ! - vol_target = 0.0 - DO i=1,ntarget - vol_target = vol_target+terr_target(i)*area_target(i) - ! if (ABS(area_target(i)-area_target_coarse(i))>0.000001) THEN - ! WRITE(*,*) "xxx",area_target(i),area_target_coarse(i),area_target(i)-area_target_coarse(i) - ! STOP - ! END IF - END DO - WRITE(*,*) "mean height (globally) of topography about sea-level for target grid filtered elevation",& - vol_target/area_target_total - WRITE(*,*) "percentage change in mean height between filtered and unfiltered elevations",& - 100.0*(vol_target-vol_target_un)/vol_target_un - WRITE(*,*) "percentage change in mean height between input cubed-sphere and unfiltered elevations",& - 100.0*(vol_source-vol_target_un)/vol_source - - END IF - ! - ! Done internal smoothing - ! - WRITE(*,*) "min/max of terr_target : ",MINVAL(terr_target),MAXVAL(terr_target) - - if (lzero_out_ocean_point_phis) then - WRITE(*,*) "if ocean mask PHIS=0.0" - end if - - - sgh_target=0.0 - do count=1,jall - i = weights_lgr_index_all(count)!! - ! - ix = weights_eul_index_all(count,1) - iy = weights_eul_index_all(count,2) - ip = weights_eul_index_all(count,3) - ! - ! convert to 1D indexing of cubed-sphere - ! - ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix! - - wt = weights_all(count,1) - - if (lzero_out_ocean_point_phis.AND.landfrac_target(i).lt.0.01_r8) then - terr_target(i) = 0.0_r8 !5*terr_target(i) - end if - sgh_target(i) = sgh_target(i)+wt*((terr_target(i)-terr(ii))**2)/area_target(i) - end do - - - - ! - ! zero out small values - ! - DO i=1,ntarget - IF (landfrac_target(i)<.001_r8) landfrac_target(i) = 0.0 - IF (sgh_target(i)<0.5) sgh_target(i) = 0.0 - IF (sgh30_target(i)<0.5) sgh30_target(i) = 0.0 - END DO - sgh_target = SQRT(sgh_target) - sgh30_target = SQRT(sgh30_target) - WRITE(*,*) "min/max of sgh_target : ",MINVAL(sgh_target),MAXVAL(sgh_target) - WRITE(*,*) "min/max of sgh30_target : ",MINVAL(sgh30_target),MAXVAL(sgh30_target) - - DEALLOCATE(terr,weights_all,weights_eul_index_all,landfrac,landm_coslat) - - - IF (ltarget_latlon) THEN - CALL wrtncdf_rll(nlon,nlat,lpole,ntarget,terr_target,landfrac_target,sgh_target,sgh30_target,& - landm_coslat_target,target_center_lon,target_center_lat,.true.) - ELSE - CALL wrtncdf_unstructured(ntarget,terr_target,landfrac_target,sgh_target,sgh30_target,& - landm_coslat_target,target_center_lon,target_center_lat) - END IF - DEALLOCATE(terr_target,landfrac_target,sgh30_target,sgh_target,landm_coslat_target) - -end program convterr - -! -! -! -subroutine wrtncdf_unstructured(n,terr,landfrac,sgh,sgh30,landm_coslat,lon,lat) - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none - -# include - - ! - ! Dummy arguments - ! - integer, intent(in) :: n - real(r8),dimension(n) , intent(in) :: terr, landfrac,sgh,sgh30,lon, lat, landm_coslat - ! - ! Local variables - ! - character (len=64) :: fout ! NetCDF output file - integer :: foutid ! Output file id - integer :: lonid, lonvid - integer :: latid, latvid - integer :: terrid,nid - integer :: terrdim,landfracid,sghid,sgh30id,landm_coslatid - integer :: status ! return value for error control of netcdf routin - integer :: i,j - integer, dimension(2) :: nc_lat_vid,nc_lon_vid - character (len=8) :: datestring - integer :: nc_gridcorn_id, lat_vid, lon_vid - - real(r8), parameter :: fillvalue = 1.d36 - - fout='new-topo-file.nc' - ! - ! Create NetCDF file for output - ! - print *,"Create NetCDF file for output" - status = nf_create (fout, NF_64BIT_OFFSET , foutid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - ! Create dimensions for output - ! - status = nf_def_dim (foutid, 'ncol', n, nid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - ! Create variable for output - ! - print *,"Create variable for output" - status = nf_def_var (foutid,'PHIS', NF_DOUBLE, 1, nid, terrid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'LANDFRAC', NF_DOUBLE, 1, nid, landfracid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'SGH', NF_DOUBLE, 1, nid, sghid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'SGH30', NF_DOUBLE, 1, nid, sgh30id) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'LANDM_COSLAT', NF_DOUBLE, 1, nid, landm_coslatid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - status = nf_def_var (foutid,'lat', NF_DOUBLE, 1, nid, latvid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'lon', NF_DOUBLE, 1, nid, lonvid) - if (status .ne. NF_NOERR) call handle_err(status) - - ! - ! Create attributes for output variables - ! - status = nf_put_att_text (foutid,terrid,'long_name', 21, 'surface geopotential') - status = nf_put_att_text (foutid,terrid,'units', 5, 'm2/s2') - status = nf_put_att_double (foutid, terrid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, terrid, '_FillValue' , nf_double, 1, fillvalue) - ! status = nf_put_att_text (foutid,terrid,'filter', 35, 'area averaged from USGS 30-sec data') - - status = nf_put_att_double (foutid, sghid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, sghid, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, sghid, 'long_name' , 48, & - 'standard deviation of 3km cubed-sphere elevation and target grid elevation') - status = nf_put_att_text (foutid, sghid, 'units' , 1, 'm') - ! status = nf_put_att_text (foutid, sghid, 'filter' , 4, 'none') - - status = nf_put_att_double (foutid, sgh30id, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, sgh30id, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, sgh30id, 'long_name' , 49, & - 'standard deviation of 30s elevation from 3km cubed-sphere cell average height') - status = nf_put_att_text (foutid, sgh30id, 'units' , 1, 'm') - ! status = nf_put_att_text (foutid, sgh30id, 'filter' , 4, 'none') - - status = nf_put_att_double (foutid, landm_coslatid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, landm_coslatid, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, landm_coslatid, 'long_name' , 23, 'smoothed land fraction') - status = nf_put_att_text (foutid, landm_coslatid, 'filter' , 4, 'none') - - status = nf_put_att_double (foutid, landfracid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, landfracid, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, landfracid, 'long_name', 21, 'gridbox land fraction') - ! status = nf_put_att_text (foutid, landfracid, 'filter', 40, 'area averaged from 30-sec USGS raw data') - - - status = nf_put_att_text (foutid,latvid,'long_name', 8, 'latitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,latvid,'units', 13, 'degrees_north') - if (status .ne. NF_NOERR) call handle_err(status) - ! status = nf_put_att_text (foutid,latvid,'units', 21, 'cell center locations') - ! if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,lonvid,'long_name', 9, 'longitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,lonvid,'units', 12, 'degrees_east') - if (status .ne. NF_NOERR) call handle_err(status) - ! status = nf_put_att_text (foutid,lonvid,'units' , 21, 'cell center locations') - ! if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,NF_GLOBAL,'source', 50, 'USGS 30-sec dataset binned to ncube3000 (cube-sphere) grid') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,NF_GLOBAL,'title', 24, '30-second USGS topo data') - if (status .ne. NF_NOERR) call handle_err(status) - call DATE_AND_TIME(DATE=datestring) - status = nf_put_att_text (foutid,NF_GLOBAL,'history',25, 'Written on date: ' // datestring ) - if (status .ne. NF_NOERR) call handle_err(status) - - ! - ! End define mode for output file - ! - status = nf_enddef (foutid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - ! Write variable for output - ! - print*,"writing terrain data",MINVAL(terr),MAXVAL(terr) - status = nf_put_var_double (foutid, terrid, terr*9.80616) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing terrain data" - - print*,"writing landfrac data",MINVAL(landfrac),MAXVAL(landfrac) - status = nf_put_var_double (foutid, landfracid, landfrac) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing landfrac data" - - print*,"writing sgh data",MINVAL(sgh),MAXVAL(sgh) - status = nf_put_var_double (foutid, sghid, sgh) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing sgh data" - - print*,"writing sgh30 data",MINVAL(sgh30),MAXVAL(sgh30) - status = nf_put_var_double (foutid, sgh30id, sgh30) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing sgh30 data" - - print*,"writing landm_coslat data",MINVAL(landm_coslat),MAXVAL(landm_coslat) - status = nf_put_var_double (foutid, landm_coslatid, landm_coslat) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing sgh30 data" - ! - print*,"writing lat data" - status = nf_put_var_double (foutid, latvid, lat) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing lat data" - - print*,"writing lon data" - status = nf_put_var_double (foutid, lonvid, lon) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing lon data" - ! - ! Close output file - ! - print *,"close file" - status = nf_close (foutid) - if (status .ne. NF_NOERR) call handle_err(status) -end subroutine wrtncdf_unstructured -! -!************************************************************** -! -! if target grid is lat-lon output structured -! -!************************************************************** -! -subroutine wrtncdf_rll(nlon,nlat,lpole,n,terr_in,landfrac_in,sgh_in,sgh30_in,landm_coslat_in,lon,lat,lprepare_fv_smoothing_routine) - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none - -# include - - ! - ! Dummy arguments - ! - integer, intent(in) :: n,nlon,nlat - ! - ! lprepare_fv_smoothing_routine is to make a NetCDF file that can be used with the CAM-FV smoothing software - ! - logical , intent(in) :: lpole,lprepare_fv_smoothing_routine - real(r8),dimension(n) , intent(in) :: terr_in, landfrac_in,sgh_in,sgh30_in,lon, lat, landm_coslat_in - ! - ! Local variables - ! - character (len=32) :: fout ! NetCDF output file - integer :: foutid ! Output file id - integer :: lonid, lonvid - integer :: latid, latvid - integer :: terrid,nid - integer :: terrdim,landfracid,sghid,sgh30id,landm_coslatid - integer :: status ! return value for error control of netcdf routin - integer :: i,j - integer, dimension(2) :: nc_lat_vid,nc_lon_vid - character (len=8) :: datestring - integer :: nc_gridcorn_id, lat_vid, lon_vid - real(r8), parameter :: fillvalue = 1.d36 - real(r8) :: ave - - real(r8),dimension(nlon) :: lonar ! longitude array - real(r8),dimension(nlat) :: latar ! latitude array - - integer, dimension(2) :: htopodim,landfdim,sghdim,sgh30dim,landmcoslatdim - real(r8),dimension(n) :: terr, landfrac,sgh,sgh30,landm_coslat - - IF (nlon*nlat.NE.n) THEN - WRITE(*,*) "inconsistent input for wrtncdf_rll" - STOP - END IF - ! - ! we assume that the unstructured layout of the lat-lon grid is ordered in latitude rows, that is, - ! unstructured index n is given by - ! - ! n = (j-1)*nlon+i - ! - ! where j is latitude index and i longitude index - ! - do i = 1,nlon - lonar(i)= lon(i) - enddo - do j = 1,nlat - latar(j)= lat((j-1)*nlon+1) - enddo - - terr = terr_in - sgh=sgh_in - sgh30 =sgh30_in - landfrac = landfrac_in - landm_coslat = landm_coslat_in - - if (lpole) then - write(*,*) "average pole control volume" - ! - ! North pole - terr - ! - ave = 0.0 - do i=1,nlon - ave = ave + terr_in(i) - end do - terr(1:nlon) = ave/DBLE(nlon) - ! - ! South pole - ! - ave = 0.0 - do i=n-(nlon+1),n - ave = ave + terr_in(i) - end do - terr(n-(nlon+1):n) = ave/DBLE(nlon) - - ! - ! North pole - sgh - ! - ave = 0.0 - do i=1,nlon - ave = ave + sgh_in(i) - end do - sgh(1:nlon) = ave/DBLE(nlon) - ! - ! South pole - ! - ave = 0.0 - do i=n-(nlon+1),n - ave = ave + sgh_in(i) - end do - sgh(n-(nlon+1):n) = ave/DBLE(nlon) - - ! - ! North pole - sgh30 - ! - ave = 0.0 - do i=1,nlon - ave = ave + sgh30_in(i) - end do - sgh30(1:nlon) = ave/DBLE(nlon) - ! - ! South pole - ! - ave = 0.0 - do i=n-(nlon+1),n - ave = ave + sgh30_in(i) - end do - sgh30(n-(nlon+1):n) = ave/DBLE(nlon) - - ! - ! North pole - landfrac - ! - ave = 0.0 - do i=1,nlon - ave = ave + landfrac_in(i) - end do - landfrac(1:nlon) = ave/DBLE(nlon) - ! - ! South pole - ! - ave = 0.0 - do i=n-(nlon+1),n - ave = ave + landfrac_in(i) - end do - landfrac(n-(nlon+1):n) = ave/DBLE(nlon) - - ! - ! North pole - landm_coslat - ! - ave = 0.0 - do i=1,nlon - ave = ave + landm_coslat_in(i) - end do - landm_coslat(1:nlon) = ave/DBLE(nlon) - ! - ! South pole - ! - ave = 0.0 - do i=n-(nlon+1),n - ave = ave + landm_coslat_in(i) - end do - landm_coslat(n-(nlon+1):n) = ave/DBLE(nlon) - end if - - - fout='final.nc' - ! - ! Create NetCDF file for output - ! - print *,"Create NetCDF file for output" - status = nf_create (fout, NF_64BIT_OFFSET , foutid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - ! Create dimensions for output - ! - print *,"Create dimensions for output" - status = nf_def_dim (foutid, 'lon', nlon, lonid) - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_def_dim (foutid, 'lat', nlat, latid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - ! Create variable for output - ! - print *,"Create variable for output" - - htopodim(1)=lonid - htopodim(2)=latid - - if (lprepare_fv_smoothing_routine) then - status = nf_def_var (foutid,'htopo', NF_DOUBLE, 2, htopodim, terrid) - else - status = nf_def_var (foutid,'PHIS', NF_DOUBLE, 2, htopodim, terrid) - end if - if (status .ne. NF_NOERR) call handle_err(status) - - landfdim(1)=lonid - landfdim(2)=latid - - if (lprepare_fv_smoothing_routine) then - status = nf_def_var (foutid,'ftopo', NF_DOUBLE, 2, landfdim, landfracid) - else - status = nf_def_var (foutid,'LANDFRAC', NF_DOUBLE, 2, landfdim, landfracid) - end if - - if (status .ne. NF_NOERR) call handle_err(status) - - sghdim(1)=lonid - sghdim(2)=latid - - status = nf_def_var (foutid,'SGH', NF_DOUBLE, 2, sghdim, sghid) - if (status .ne. NF_NOERR) call handle_err(status) - - sgh30dim(1)=lonid - sgh30dim(2)=latid - - status = nf_def_var (foutid,'SGH30', NF_DOUBLE, 2, sgh30dim, sgh30id) - if (status .ne. NF_NOERR) call handle_err(status) - - landmcoslatdim(1)=lonid - landmcoslatdim(2)=latid - - status = nf_def_var (foutid,'LANDM_COSLAT', NF_DOUBLE, 2, landmcoslatdim, landm_coslatid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'lat', NF_DOUBLE, 1, latid, latvid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'lon', NF_DOUBLE, 1, lonid, lonvid) - if (status .ne. NF_NOERR) call handle_err(status) - - ! - ! Create attributes for output variables - ! - status = nf_put_att_text (foutid,terrid,'long_name', 21, 'surface geopotential') - status = nf_put_att_text (foutid,terrid,'units', 5, 'm2/s2') - status = nf_put_att_text (foutid,terrid,'filter', 35, 'area averaged from ncube3000 data') - status = nf_put_att_double (foutid, terrid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, terrid, '_FillValue' , nf_double, 1, fillvalue) - - - status = nf_put_att_double (foutid, sghid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, sghid, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, sghid, 'long_name' , 48, & - 'standard deviation of 3km cubed-sphere elevation and target grid elevation') - status = nf_put_att_text (foutid, sghid, 'units' , 1, 'm') - status = nf_put_att_text (foutid, sghid, 'filter' , 4, 'none') - - status = nf_put_att_double (foutid, sgh30id, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, sgh30id, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, sgh30id, 'long_name' , 49, & - 'standard deviation of 30s elevation from 3km cubed-sphere cell average height') - status = nf_put_att_text (foutid, sgh30id, 'units' , 1, 'm') - status = nf_put_att_text (foutid, sgh30id, 'filter' , 4, 'none') - - status = nf_put_att_double (foutid, landm_coslatid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, landm_coslatid, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, landm_coslatid, 'long_name' , 23, 'smoothed land fraction') - status = nf_put_att_text (foutid, landm_coslatid, 'filter' , 4, 'none') - - status = nf_put_att_double (foutid, landfracid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, landfracid, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, landfracid, 'long_name', 21, 'gridbox land fraction') - status = nf_put_att_text (foutid, landfracid, 'filter', 40, 'area averaged from 30-sec USGS raw data') - - - status = nf_put_att_text (foutid,latvid,'long_name', 8, 'latitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,latvid,'units', 13, 'degrees_north') - if (status .ne. NF_NOERR) call handle_err(status) - ! status = nf_put_att_text (foutid,latvid,'units', 21, 'cell center locations') - ! if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,lonvid,'long_name', 9, 'longitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,lonvid,'units', 12, 'degrees_east') - if (status .ne. NF_NOERR) call handle_err(status) - ! status = nf_put_att_text (foutid,lonvid,'units' , 21, 'cell center locations') - ! if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,NF_GLOBAL,'source', 27, 'USGS 30-sec dataset GTOPO30') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,NF_GLOBAL,'title', 24, '30-second USGS topo data') - if (status .ne. NF_NOERR) call handle_err(status) - call DATE_AND_TIME(DATE=datestring) - status = nf_put_att_text (foutid,NF_GLOBAL,'history',25, 'Written on date: ' // datestring ) - if (status .ne. NF_NOERR) call handle_err(status) - - ! - ! End define mode for output file - ! - status = nf_enddef (foutid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - ! Write variable for output - ! - print*,"writing terrain data",MINVAL(terr),MAXVAL(terr) - if (lprepare_fv_smoothing_routine) then - status = nf_put_var_double (foutid, terrid, terr) - else - status = nf_put_var_double (foutid, terrid, terr*9.80616) - end if - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing terrain data" - - print*,"writing landfrac data",MINVAL(landfrac),MAXVAL(landfrac) - status = nf_put_var_double (foutid, landfracid, landfrac) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing landfrac data" - - print*,"writing sgh data",MINVAL(sgh),MAXVAL(sgh) - status = nf_put_var_double (foutid, sghid, sgh) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing sgh data" - - print*,"writing sgh30 data",MINVAL(sgh30),MAXVAL(sgh30) - status = nf_put_var_double (foutid, sgh30id, sgh30) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing sgh30 data" - - print*,"writing landm_coslat data",MINVAL(landm_coslat),MAXVAL(landm_coslat) - status = nf_put_var_double (foutid, landm_coslatid, landm_coslat) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing sgh30 data" - ! - print*,"writing lat data" - status = nf_put_var_double (foutid, latvid, latar) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing lat data" - - print*,"writing lon data" - status = nf_put_var_double (foutid, lonvid, lonar) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing lon data" - ! - ! Close output file - ! - print *,"close file" - status = nf_close (foutid) - if (status .ne. NF_NOERR) call handle_err(status) -end subroutine wrtncdf_rll -!************************************************************************ -!!handle_err -!************************************************************************ -! -!!ROUTINE: handle_err -!!DESCRIPTION: error handler -!-------------------------------------------------------------------------- - -subroutine handle_err(status) - - implicit none - -# include - - integer status - - if (status .ne. nf_noerr) then - print *, nf_strerror(status) - stop 'Stopped' - endif - -end subroutine handle_err - - -SUBROUTINE coarsen(f,fcoarse,nf,n,dA_coarse) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - REAL (R8), DIMENSION(n) , INTENT(IN) :: f - REAL (R8), DIMENSION(n/nf), INTENT(OUT) :: fcoarse - INTEGER, INTENT(in) :: n,nf - REAL(R8), DIMENSION(INT(SQRT(DBLE(n/6)))/nf,INT(SQRT(DBLE(n/6)))/nf),INTENT(OUT) :: dA_coarse - !must be an even number - ! - ! local workspace - ! - ! ncube = INT(SQRT(DBLE(n/6))) - - REAL(R8), DIMENSION(INT(SQRT(DBLE(n/6))),INT(SQRT(DBLE(n/6)))):: dA - REAL (R8) :: sum, sum_area,tmp - INTEGER :: jx,jy,jp,ii,ii_coarse,coarse_ncube,ncube - INTEGER :: jx_coarse,jy_coarse,jx_s,jy_s - - - ! REAL(R8), DIMENSION(INT(SQRT(DBLE(n/6)))/nf,INT(SQRT(DBLE(n/6)))/nf) :: dAtmp - - ncube = INT(SQRT(DBLE(n/6))) - coarse_ncube = ncube/nf - - IF (ABS(DBLE(ncube)/DBLE(nf)-coarse_ncube)>0.000001) THEN - WRITE(*,*) "ncube/nf must be an integer" - WRITE(*,*) "ncube and nf: ",ncube,nf - STOP - END IF - - da_coarse = 0.0 - - WRITE(*,*) "compute all areas" - CALL EquiangularAllAreas(ncube, dA) - ! CALL EquiangularAllAreas(coarse_ncube, dAtmp)!dbg - tmp = 0.0 - DO jp=1,6 - DO jy_coarse=1,coarse_ncube - DO jx_coarse=1,coarse_ncube - ! - ! inner loop - ! - sum = 0.0 - sum_area = 0.0 - DO jy_s=1,nf - jy = (jy_coarse-1)*nf+jy_s - DO jx_s=1,nf - jx = (jx_coarse-1)*nf+jx_s - ii = (jp-1)*ncube*ncube+(jy-1)*ncube+jx - sum = sum +f(ii)*dA(jx,jy) - sum_area = sum_area+dA(jx,jy) - ! WRITE(*,*) "jx,jy",jx,jy - END DO - END DO - tmp = tmp+sum_area - da_coarse(jx_coarse,jy_coarse) = sum_area - ! WRITE(*,*) "jx_coarse,jy_coarse",jx_coarse,jy_coarse,& - ! da_coarse(jx_coarse,jy_coarse)-datmp(jx_coarse,jy_coarse) - ii_coarse = (jp-1)*coarse_ncube*coarse_ncube+(jy_coarse-1)*coarse_ncube+jx_coarse - fcoarse(ii_coarse) = sum/sum_area - END DO - END DO - END DO - WRITE(*,*) "coarsened surface area",tmp-4.0*3.141592654 -END SUBROUTINE COARSEN - -SUBROUTINE overlap_weights(weights_lgr_index_all,weights_eul_index_all,weights_all,& - jall,ncube,ngauss,ntarget,ncorner,jmax_segments,target_corner_lon,target_corner_lat,nreconstruction) - use shr_kind_mod, only: r8 => shr_kind_r8 - use remap - IMPLICIT NONE - - - INTEGER, INTENT(INOUT) :: jall !anticipated number of weights - INTEGER, INTENT(IN) :: ncube, ngauss, ntarget, jmax_segments, ncorner, nreconstruction - - INTEGER, DIMENSION(jall,3), INTENT(OUT) :: weights_eul_index_all - REAL(R8), DIMENSION(jall,nreconstruction) , INTENT(OUT) :: weights_all - INTEGER, DIMENSION(jall) , INTENT(OUT) :: weights_lgr_index_all - - REAL(R8), DIMENSION(ncorner,ntarget), INTENT(IN) :: target_corner_lon, target_corner_lat - - INTEGER, DIMENSION(ncorner+1) :: ipanel_array, ipanel_tmp - REAL(R8), DIMENSION(ncorner) :: lat, lon - REAL(R8), DIMENSION(0:ncube+2):: xgno, ygno - REAL(R8), DIMENSION(0:ncorner+1) :: xcell, ycell - - REAL(R8), DIMENSION(ngauss) :: gauss_weights, abscissae - - REAL(R8) :: da, tmp, alpha, beta - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - REAL (r8), PARAMETER :: pih = 0.50*pi - INTEGER :: i, j,ncorner_this_cell,k,ip,ipanel,ii,jx,jy,jcollect - integer :: alloc_error - - REAL (r8), PARAMETER :: rad2deg = 180.0/pi - - real(r8), allocatable, dimension(:,:) :: weights - integer , allocatable, dimension(:,:) :: weights_eul_index - - - LOGICAL:: ldbg = .FAlSE. - - INTEGER :: jall_anticipated - - jall_anticipated = jall - - ipanel_array = -99 - ! - da = pih/DBLE(ncube) - xgno(0) = -bignum - DO i=1,ncube+1 - xgno(i) = TAN(-piq+(i-1)*da) - END DO - xgno(ncube+2) = bignum - ygno = xgno - - CALL glwp(ngauss,gauss_weights,abscissae) - - - allocate (weights(jmax_segments,nreconstruction),stat=alloc_error ) - allocate (weights_eul_index(jmax_segments,2),stat=alloc_error ) - - tmp = 0.0 - jall = 1 - DO i=1,ntarget - WRITE(*,*) "cell",i," ",100.0*DBLE(i)/DBLE(ntarget),"% done" - ! - !--------------------------------------------------- - ! - ! determine how many vertices the cell has - ! - !--------------------------------------------------- - ! - CALL remove_duplicates_latlon(ncorner,target_corner_lon(:,i),target_corner_lat(:,i),& - ncorner_this_cell,lon,lat,1.0E-10,ldbg) - - IF (ldbg) THEN - WRITE(*,*) "number of vertices ",ncorner_this_cell - WRITE(*,*) "vertices locations lon,",lon(1:ncorner_this_cell)*rad2deg - WRITE(*,*) "vertices locations lat,",lat(1:ncorner_this_cell)*rad2deg - DO j=1,ncorner_this_cell - WRITE(*,*) lon(j)*rad2deg, lat(j)*rad2deg - END DO - WRITE(*,*) " " - END IF - ! - !--------------------------------------------------- - ! - ! determine how many and which panels the cell spans - ! - !--------------------------------------------------- - ! - DO j=1,ncorner_this_cell - CALL CubedSphereABPFromRLL(lon(j), lat(j), alpha, beta, ipanel_tmp(j), .TRUE.) - IF (ldbg) WRITE(*,*) "ipanel for corner ",j," is ",ipanel_tmp(j) - END DO - ipanel_tmp(ncorner_this_cell+1) = ipanel_tmp(1) - ! make sure to include possible overlap areas not on the face the vertices are located - IF (MINVAL(lat(1:ncorner_this_cell))<-pi/6.0) THEN - ! include South-pole panel in search - ipanel_tmp(ncorner_this_cell+1) = 5 - IF (ldbg) WRITE(*,*) "add panel 5 to search" - END IF - IF (MAXVAL(lat(1:ncorner_this_cell))>pi/6.0) THEN - ! include North-pole panel in search - ipanel_tmp(ncorner_this_cell+1) = 6 - IF (ldbg) WRITE(*,*) "add panel 6 to search" - END IF - ! - ! remove duplicates in ipanel_tmp - ! - CALL remove_duplicates_integer(ncorner_this_cell+1,ipanel_tmp(1:ncorner_this_cell+1),& - k,ipanel_array(1:ncorner_this_cell+1)) - ! - !--------------------------------------------------- - ! - ! loop over panels with possible overlap areas - ! - !--------------------------------------------------- - ! - DO ip = 1,k - ipanel = ipanel_array(ip) - DO j=1,ncorner_this_cell - ii = ipanel - CALL CubedSphereABPFromRLL(lon(j), lat(j), alpha, beta, ii,.FALSE.) - IF (j==1) THEN - jx = CEILING((alpha + piq) / da) - jy = CEILING((beta + piq) / da) - END IF - xcell(ncorner_this_cell+1-j) = TAN(alpha) - ycell(ncorner_this_cell+1-j) = TAN(beta) - END DO - xcell(0) = xcell(ncorner_this_cell) - ycell(0) = ycell(ncorner_this_cell) - xcell(ncorner_this_cell+1) = xcell(1) - ycell(ncorner_this_cell+1) = ycell(1) - - jx = MAX(MIN(jx,ncube+1),0) - jy = MAX(MIN(jy,ncube+1),0) - - CALL compute_weights_cell(xcell(0:ncorner_this_cell+1),ycell(0:ncorner_this_cell+1),& - jx,jy,nreconstruction,xgno,ygno,& - 1, ncube+1, 1,ncube+1, tmp,& - ngauss,gauss_weights,abscissae,weights,weights_eul_index,jcollect,jmax_segments,& - ncube,0,ncorner_this_cell,ldbg) - - weights_all(jall:jall+jcollect-1,1:nreconstruction) = weights(1:jcollect,1:nreconstruction) - - weights_eul_index_all(jall:jall+jcollect-1,1:2) = weights_eul_index(1:jcollect,:) - weights_eul_index_all(jall:jall+jcollect-1, 3) = ipanel - weights_lgr_index_all(jall:jall+jcollect-1 ) = i - - jall = jall+jcollect - IF (jall>jall_anticipated) THEN - WRITE(*,*) "more weights than anticipated" - WRITE(*,*) "increase jall" - STOP - END IF - IF (ldbg) WRITE(*,*) "jcollect",jcollect - END DO - END DO - jall = jall-1 - WRITE(*,*) "sum of all weights divided by surface area of sphere =",tmp/(4.0*pi) - WRITE(*,*) "actual number of weights",jall - WRITE(*,*) "anticipated number of weights",jall_anticipated - IF (jall>jall_anticipated) THEN - WRITE(*,*) "anticipated number of weights < actual number of weights" - WRITE(*,*) "increase jall!" - STOP - END IF - WRITE(*,*) MINVAL(weights_all(1:jall,1)),MAXVAL(weights_all(1:jall,1)) - IF (ABS(tmp/(4.0*pi))-1.0>0.001) THEN - WRITE(*,*) "sum of all weights does not match the surface area of the sphere" - WRITE(*,*) "sum of all weights is : ",tmp - WRITE(*,*) "surface area of sphere: ",4.0*pi - STOP - END IF -END SUBROUTINE overlap_weights - - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereABPFromRLL -! -! Description: -! Determine the (alpha,beta,panel) coordinate of a point on the sphere from -! a given regular lat lon coordinate. -! -! Parameters: -! lon - Coordinate longitude -! lat - Coordinate latitude -! alpha (OUT) - Alpha coordinate -! beta (OUT) - Beta coordinate -! ipanel (OUT) - Face panel -!------------------------------------------------------------------------------ -SUBROUTINE CubedSphereABPFromRLL(lon, lat, alpha, beta, ipanel, ldetermine_panel) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - - REAL (R8), INTENT(IN) :: lon, lat - REAL (R8), INTENT(OUT) :: alpha, beta - INTEGER :: ipanel - LOGICAL, INTENT(IN) :: ldetermine_panel - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - REAL (r8), PARAMETER :: rotate_cube = 0.0 - - ! Local variables - REAL (R8) :: xx, yy, zz, pm - REAL (R8) :: sx, sy, sz - INTEGER :: ix, iy, iz - - ! Translate to (x,y,z) space - xx = COS(lon-rotate_cube) * COS(lat) - yy = SIN(lon-rotate_cube) * COS(lat) - zz = SIN(lat) - - pm = MAX(ABS(xx), ABS(yy), ABS(zz)) - - ! Check maximality of the x coordinate - IF (pm == ABS(xx)) THEN - IF (xx > 0) THEN; ix = 1; ELSE; ix = -1; ENDIF - ELSE - ix = 0 - ENDIF - - ! Check maximality of the y coordinate - IF (pm == ABS(yy)) THEN - IF (yy > 0) THEN; iy = 1; ELSE; iy = -1; ENDIF - ELSE - iy = 0 - ENDIF - - ! Check maximality of the z coordinate - IF (pm == ABS(zz)) THEN - IF (zz > 0) THEN; iz = 1; ELSE; iz = -1; ENDIF - ELSE - iz = 0 - ENDIF - - ! Panel assignments - IF (ldetermine_panel) THEN - IF (iz == 1) THEN - ipanel = 6; sx = yy; sy = -xx; sz = zz - - ELSEIF (iz == -1) THEN - ipanel = 5; sx = yy; sy = xx; sz = -zz - - ELSEIF ((ix == 1) .AND. (iy /= 1)) THEN - ipanel = 1; sx = yy; sy = zz; sz = xx - - ELSEIF ((ix == -1) .AND. (iy /= -1)) THEN - ipanel = 3; sx = -yy; sy = zz; sz = -xx - - ELSEIF ((iy == 1) .AND. (ix /= -1)) THEN - ipanel = 2; sx = -xx; sy = zz; sz = yy - - ELSEIF ((iy == -1) .AND. (ix /= 1)) THEN - ipanel = 4; sx = xx; sy = zz; sz = -yy - - ELSE - WRITE(*,*) 'Fatal Error: CubedSphereABPFromRLL failed' - WRITE(*,*) '(xx, yy, zz) = (', xx, ',', yy, ',', zz, ')' - WRITE(*,*) 'pm =', pm, ' (ix, iy, iz) = (', ix, ',', iy, ',', iz, ')' - STOP - ENDIF - ELSE - IF (ipanel == 6) THEN - sx = yy; sy = -xx; sz = zz - ELSEIF (ipanel == 5) THEN - sx = yy; sy = xx; sz = -zz - ELSEIF (ipanel == 1) THEN - sx = yy; sy = zz; sz = xx - ELSEIF (ipanel == 3) THEN - sx = -yy; sy = zz; sz = -xx - ELSEIF (ipanel == 2) THEN - sx = -xx; sy = zz; sz = yy - ELSEIF (ipanel == 4) THEN - sx = xx; sy = zz; sz = -yy - ELSE - WRITE(*,*) "ipanel out of range",ipanel - STOP - END IF - END IF - - ! Use panel information to calculate (alpha, beta) coords - alpha = ATAN(sx / sz) - beta = ATAN(sy / sz) - -END SUBROUTINE CubedSphereABPFromRLL - -!------------------------------------------------------------------------------ -! SUBROUTINE EquiangularAllAreas -! -! Description: -! Compute the area of all cubed sphere grid cells, storing the results in -! a two dimensional array. -! -! Parameters: -! icube - Resolution of the cubed sphere -! dA (OUT) - Output array containing the area of all cubed sphere grid cells -!------------------------------------------------------------------------------ -SUBROUTINE EquiangularAllAreas(icube, dA) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - - INTEGER, INTENT(IN) :: icube - REAL (r8), DIMENSION(icube,icube), INTENT(OUT) :: dA - - ! Local variables - INTEGER :: k, k1, k2 - REAL (r8) :: a1, a2, a3, a4 - REAL (r8), DIMENSION(icube+1,icube+1) :: ang - REAL (r8), DIMENSION(icube+1) :: gp - - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - - - !#ifdef DBG - REAL (r8) :: dbg1 !DBG - !#endif - - ! Recall that we are using equi-angular spherical gridding - ! Compute the angle between equiangular cubed sphere projection grid lines. - DO k = 1, icube+1 - gp(k) = -piq + (pi/DBLE(2*(icube))) * DBLE(k-1) - ENDDO - - DO k2=1,icube+1 - DO k1=1,icube+1 - ang(k1,k2) =ACOS(-SIN(gp(k1)) * SIN(gp(k2))) - ENDDO - ENDDO - - DO k2=1,icube - DO k1=1,icube - a1 = ang(k1 , k2 ) - a2 = pi - ang(k1+1, k2 ) - a3 = pi - ang(k1 , k2+1) - a4 = ang(k1+1, k2+1) - ! area = r*r*(-2*pi+sum(interior angles)) - DA(k1,k2) = -2.0*pi+a1+a2+a3+a4 - ENDDO - ENDDO - - !#ifdef DBG - ! Only for debugging - test consistency - dbg1 = 0.0 !DBG - DO k2=1,icube - DO k1=1,icube - dbg1 = dbg1 + DA(k1,k2) !DBG - ENDDO - ENDDO - write(*,*) 'DAcube consistency: ',dbg1-4.0*pi/6.0 !DBG - !#endif -END SUBROUTINE EquiangularAllAreas - - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereRLLFromABP -! -! Description: -! Determine the lat lon coordinate of a point on a sphere given its -! (alpha,beta,panel) coordinate. -! -! Parameters: -! alpha - Alpha coordinate -! beta - Beta coordinate -! panel - Cubed sphere panel id -! lon (OUT) - Calculated longitude -! lat (OUT) - Calculated latitude -!------------------------------------------------------------------------------ -SUBROUTINE CubedSphereRLLFromABP(alpha, beta, ipanel, lon, lat) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - REAL (r8), INTENT(IN) :: alpha, beta - INTEGER , INTENT(IN) :: ipanel - REAL (r8), INTENT(OUT) :: lon, lat - ! Local variables - REAL (r8) :: xx, yy, zz, rotate_cube - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - - rotate_cube = 0.0 - ! Convert to cartesian coordinates - CALL CubedSphereXYZFromABP(alpha, beta, ipanel, xx, yy, zz) - ! Convert back to lat lon - lat = ASIN(zz) - if (xx==0.0.and.yy==0.0) THEN - lon = 0.0 - else - lon = ATAN2(yy, xx) +rotate_cube - IF (lon<0.0) lon=lon+2.0*pi - IF (lon>2.0*pi) lon=lon-2.0*pi - end if -END SUBROUTINE CubedSphereRLLFromABP - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereXYZFromABP -! -! Description: -! Determine the Cartesian coordinate of a point on a sphere given its -! (alpha,beta,panel) coordinate. -! -! Parameters: -! alpha - Alpha coordinate -! beta - Beta coordinate -! panel - Cubed sphere panel id -! xx (OUT) - Calculated x coordinate -! yy (OUT) - Calculated y coordinate -! zz (OUT) - Calculated z coordinate -!------------------------------------------------------------------------------ -SUBROUTINE CubedSphereXYZFromABP(alpha, beta, ipanel, xx, yy, zz) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - - REAL (r8), INTENT(IN) :: alpha, beta - INTEGER , INTENT(IN) :: ipanel - REAL (r8), INTENT(OUT) :: xx, yy, zz - ! Local variables - REAL (r8) :: a1, b1, pm - REAL (r8) :: sx, sy, sz - - ! Convert to Cartesian coordinates - a1 = TAN(alpha) - b1 = TAN(beta) - - sz = (1.0 + a1 * a1 + b1 * b1)**(-0.5) - sx = sz * a1 - sy = sz * b1 - ! Panel assignments - IF (ipanel == 6) THEN - yy = sx; xx = -sy; zz = sz - ELSEIF (ipanel == 5) THEN - yy = sx; xx = sy; zz = -sz - ELSEIF (ipanel == 1) THEN - yy = sx; zz = sy; xx = sz - ELSEIF (ipanel == 3) THEN - yy = -sx; zz = sy; xx = -sz - ELSEIF (ipanel == 2) THEN - xx = -sx; zz = sy; yy = sz - ELSEIF (ipanel == 4) THEN - xx = sx; zz = sy; yy = -sz - ELSE - WRITE(*,*) 'Fatal Error: Panel out of range in CubedSphereXYZFromABP' - WRITE(*,*) '(alpha, beta, panel) = (', alpha, ',', beta, ',', ipanel, ')' - STOP - ENDIF -END SUBROUTINE CubedSphereXYZFromABP - - -SUBROUTINE remove_duplicates_integer(n_in,f_in,n_out,f_out) - use shr_kind_mod, only: r8 => shr_kind_r8 - integer, intent(in) :: n_in - integer,dimension(n_in), intent(in) :: f_in - integer, intent(out) :: n_out - integer,dimension(n_in), intent(out) :: f_out - ! - ! local work space - ! - integer :: k,i,j - ! - ! remove duplicates in ipanel_tmp - ! - k = 1 - f_out(1) = f_in(1) - outer: do i=2,n_in - do j=1,k - ! if (f_out(j) == f_in(i)) then - if (ABS(f_out(j)-f_in(i))<1.0E-10) then - ! Found a match so start looking again - cycle outer - end if - end do - ! No match found so add it to the output - k = k + 1 - f_out(k) = f_in(i) - end do outer - n_out = k -END SUBROUTINE remove_duplicates_integer - -SUBROUTINE remove_duplicates_latlon(n_in,lon_in,lat_in,n_out,lon_out,lat_out,tiny,ldbg) - use shr_kind_mod, only: r8 => shr_kind_r8 - integer, intent(in) :: n_in - real(r8),dimension(n_in), intent(inout) :: lon_in,lat_in - real, intent(in) :: tiny - integer, intent(out) :: n_out - real(r8),dimension(n_in), intent(out) :: lon_out,lat_out - logical :: ldbg - ! - ! local work space - ! - integer :: k,i,j - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: pih = 0.50*pi - ! - ! for pole points: make sure the longitudes are identical so that algorithm below works properly - ! - do i=2,n_in - if (abs(lat_in(i)-pih) 0) .AND. (j < ncube_reconstruct)) THEN - beta = gp(j) - beta_next = gp(j+1) - ELSEIF (j == -1) THEN - beta = -piq - (gp(3) + piq) - beta_next = -piq - (gp(2) + piq) - ELSEIF (j == 0) THEN - beta = -piq - (gp(2) + piq) - beta_next = -piq - ELSEIF (j == ncube_reconstruct) THEN - beta = piq - beta_next = piq + (piq - gp(ncube_reconstruct-1)) - ELSEIF (j == ncube_reconstruct+1) THEN - beta = piq + (piq - gp(ncube_reconstruct-1)) - beta_next = piq + (piq - gp(ncube_reconstruct-2)) - ENDIF - - DO i = -1, ncube_reconstruct+1 - IF ((i > 0) .AND. (i < ncube_reconstruct)) THEN - alpha = gp(i) - alpha_next = gp(i+1) - ELSEIF (i == -1) THEN - alpha = -piq - (gp(3) + piq) - alpha_next = -piq - (gp(2) + piq) - ELSEIF (i == 0) THEN - alpha = -piq - (gp(2) + piq) - alpha_next = -piq - ELSEIF (i == ncube_reconstruct) THEN - alpha = piq - alpha_next = piq + (piq - gp(ncube_reconstruct-1)) - ELSEIF (i == ncube_reconstruct+1) THEN - alpha = piq + (piq - gp(ncube_reconstruct-1)) - alpha_next = piq + (piq - gp(ncube_reconstruct-2)) - ENDIF - abp_centroid(1,i,j) = & - I_10_ab(alpha_next,beta_next)-I_10_ab(alpha ,beta_next)+& - I_10_ab(alpha ,beta )-I_10_ab(alpha_next,beta ) -! - ASINH(COS(alpha_next) * TAN(beta_next)) & -! + ASINH(COS(alpha_next) * TAN(beta)) & -! + ASINH(COS(alpha) * TAN(beta_next)) & -! - ASINH(COS(alpha) * TAN(beta)) - - abp_centroid(2,i,j) = & - I_01_ab(alpha_next,beta_next)-I_01_ab(alpha ,beta_next)+& - I_01_ab(alpha ,beta )-I_01_ab(alpha_next,beta ) -! - ASINH(TAN(alpha_next) * COS(beta_next)) & -! + ASINH(TAN(alpha_next) * COS(beta)) & -! + ASINH(TAN(alpha) * COS(beta_next)) & -! - ASINH(TAN(alpha) * COS(beta)) - - !ADD PHL START - IF (order>2) THEN - ! TAN(alpha)^2 component - abp_centroid(3,i,j) =& - I_20_ab(alpha_next,beta_next)-I_20_ab(alpha ,beta_next)+& - I_20_ab(alpha ,beta )-I_20_ab(alpha_next,beta ) - - ! TAN(beta)^2 component - abp_centroid(4,i,j) = & - I_02_ab(alpha_next,beta_next)-I_02_ab(alpha ,beta_next)+& - I_02_ab(alpha ,beta )-I_02_ab(alpha_next,beta ) - - ! TAN(alpha) TAN(beta) component - abp_centroid(5,i,j) = & - I_11_ab(alpha_next,beta_next)-I_11_ab(alpha ,beta_next)+& - I_11_ab(alpha ,beta )-I_11_ab(alpha_next,beta ) - ENDIF - !ADD PHL END - ENDDO - ENDDO - -! -! PHL outcommented below -! - ! High order calculations -! IF (order > 2) THEN -! DO k = 1, nlon -! DO i = 1, int_nx(nlat,k)-1 -! IF ((int_itype(i,k) > 4) .AND. (int_np(1,i,k) == 1)) THEN -! abp_centroid(3, int_a(i,k), int_b(i,k)) = & -! abp_centroid(3, int_a(i,k), int_b(i,k)) + int_wt_2a(i,k) -! abp_centroid(4, int_a(i,k), int_b(i,k)) = & -! abp_centroid(4, int_a(i,k), int_b(i,k)) + int_wt_2b(i,k) -! abp_centroid(5, int_a(i,k), int_b(i,k)) = & -! abp_centroid(5, int_a(i,k), int_b(i,k)) + int_wt_2c(i,k) -! ENDIF -! ENDDO -! ENDDO -! ENDIF - - ! Normalize with element areas - DO j = -1, ncube_reconstruct+1 - IF ((j > 0) .AND. (j < ncube_reconstruct)) THEN - beta = gp(j) - beta_next = gp(j+1) - ELSEIF (j == -1) THEN - beta = -piq - (gp(3) + piq) - beta_next = -piq - (gp(2) + piq) - ELSEIF (j == 0) THEN - beta = -piq - (gp(2) + piq) - beta_next = -piq - ELSEIF (j == ncube_reconstruct) THEN - beta = piq - beta_next = piq + (piq - gp(ncube_reconstruct-1)) - ELSEIF (j == ncube_reconstruct+1) THEN - beta = piq + (piq - gp(ncube_reconstruct-1)) - beta_next = piq + (piq - gp(ncube_reconstruct-2)) - ENDIF - DO i = -1, ncube_reconstruct+1 - IF ((i > 0) .AND. (i < ncube_reconstruct)) THEN - alpha = gp(i) - alpha_next = gp(i+1) - ELSEIF (i == -1) THEN - alpha = -piq - (gp(3) + piq) - alpha_next = -piq - (gp(2) + piq) - ELSEIF (i == 0) THEN - alpha = -piq - (gp(2) + piq) - alpha_next = -piq - ELSEIF (i == ncube_reconstruct) THEN - alpha = piq - alpha_next = piq + (piq - gp(ncube_reconstruct-1)) - ELSEIF (i == ncube_reconstruct+1) THEN - alpha = piq + (piq - gp(ncube_reconstruct-1)) - alpha_next = piq + (piq - gp(ncube_reconstruct-2)) - ENDIF - - IF ((i > 0) .AND. (i < ncube_reconstruct) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN - area = DAcube(i,j) - ELSE - area = EquiangularElementArea(alpha, alpha_next - alpha, & - beta, beta_next - beta) - ENDIF - - abp_centroid(1,i,j) = abp_centroid(1,i,j) / area - abp_centroid(2,i,j) = abp_centroid(2,i,j) / area - - IF (order > 2) THEN - IF ((i > 0) .AND. (i < ncube_reconstruct) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN - abp_centroid(3,i,j) = abp_centroid(3,i,j) / area - abp_centroid(4,i,j) = abp_centroid(4,i,j) / area - abp_centroid(5,i,j) = abp_centroid(5,i,j) / area - ENDIF - ENDIF - ENDDO - ENDDO - - WRITE(*,*) '...Done computing ABP element centroids' - - END SUBROUTINE ComputeABPElementCentroids - -!------------------------------------------------------------------------------ -! FUNCTION EvaluateABPReconstruction -! -! Description: -! Evaluate the sub-grid scale reconstruction at the given point. -! -! Parameters: -! fcubehalo - Array of element values -! recons - Array of reconstruction coefficients -! a - Index of element in alpha direction (1 <= a <= ncube_reconstruct-1) -! b - Index of element in beta direction (1 <= b <= ncube_reconstruct-1) -! p - Panel index of element -! alpha - Alpha coordinate of evaluation point -! beta - Beta coordinate of evaluation point -! order - Order of the reconstruction -! value (OUT) - Result of function evaluation at given point -!------------------------------------------------------------------------------ - SUBROUTINE EvaluateABPReconstruction( & - fcubehalo, recons, a, b, p, alpha, beta, order, value) - IMPLICIT NONE - - ! Dummy variables - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & - INTENT(IN) :: fcubehalo - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(IN) :: recons - INTEGER (KIND=int_kind), INTENT(IN) :: a, b, p - REAL (KIND=dbl_kind), INTENT(IN) :: alpha, beta - INTEGER (KIND=int_kind), INTENT(IN) :: order - - REAL (KIND=dbl_kind), INTENT(OUT) :: value - - ! Evaluate constant order terms - value = fcubehalo(a,b,p) - - ! Evaluate linear order terms - IF (order > 1) THEN - value = value + recons(1,a,b,p) * (TAN(alpha) - abp_centroid(1,a,b)) - value = value + recons(2,a,b,p) * (TAN(beta) - abp_centroid(2,a,b)) - ENDIF - - ! Evaluate second order terms - IF (order > 2) THEN - value = value + recons(3,a,b,p) * & - (abp_centroid(1,a,b)**2 - abp_centroid(3,a,b)) - value = value + recons(4,a,b,p) * & - (abp_centroid(2,a,b)**2 - abp_centroid(4,a,b)) - value = value + recons(5,a,b,p) * & - (abp_centroid(1,a,b) * abp_centroid(2,a,b) - & - abp_centroid(5,a,b)) - - value = value + recons(3,a,b,p) * (TAN(alpha) - abp_centroid(1,a,b))**2 - value = value + recons(4,a,b,p) * (TAN(beta) - abp_centroid(2,a,b))**2 - value = value + recons(5,a,b,p) * (TAN(alpha) - abp_centroid(1,a,b)) & - * (TAN(beta) - abp_centroid(2,a,b)) - ENDIF - - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE ABPHaloMinMax -! -! Description: -! Calculate the minimum and maximum values of the cell-averaged function -! around the given element. -! -! Parameters: -! fcubehalo - Cell-averages for the cubed sphere -! a - Local element alpha index -! b - Local element beta index -! p - Local element panel index -! min_val (OUT) - Minimum value in the halo -! max_val (OUT) - Maximum value in the halo -! nomiddle - whether to not include the middle cell (index a,b) in the search. -! -! NOTE: Since this routine is not vectorized, it will likely be called MANY times. -! To speed things up, make sure to pass the first argument as the ENTIRE original -! array, not as a subset of it, since repeatedly cutting up that array and creating -! an array temporary (on some compilers) is VERY slow. -! ex: -! CALL APBHaloMinMax(zarg, a, ...) !YES -! CALL ABPHaloMinMax(zarg(-1:ncube_reconstruct+1,-1:ncube_reconstruct+1,:)) !NO -- slow -!------------------------------------------------------------------------------ - SUBROUTINE ABPHaloMinMax(fcubehalo, a, b, p, min_val, max_val, nomiddle) - IMPLICIT NONE - - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & - INTENT(IN) :: fcubehalo - - INTEGER (KIND=int_kind), INTENT(IN) :: a, b, p - REAL (KIND=dbl_kind), INTENT(OUT) :: min_val, max_val - LOGICAL, INTENT(IN) :: nomiddle - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, il, jl, inew, jnew - REAL (KIND=dbl_kind) :: value - - min_val = fcubehalo(a,b,p) - max_val = fcubehalo(a,b,p) - value = fcubehalo(a,b,p) - - DO il = a-1,a+1 - DO jl = b-1,b+1 - - i = il - j = jl - - inew = i - jnew = j - - IF (nomiddle .AND. i==a .AND. j==b) CYCLE - - !Interior - IF ((i > 0) .AND. (i < ncube_reconstruct) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN - value = fcubehalo(i,j,p) - - ELSE - - - !The next 4.0 regions are cases in which a,b themselves lie in the panel's halo, and the cell's "halo" (in this usage the 8.0 cells surrounding it) might wrap around into another part of the halo. This happens for (a,b) = {(1,:0),(ncube_reconstruct-1,:0),(1,ncube_reconstruct:),(ncube_reconstruct-1,ncube_reconstruct:)} and for the transposes thereof ({(:0,1), etc.}). In these cases (i,j) could lie in the "Corners" where nothing should lie. We correct this by moving i,j to its appropriate position on the "facing" halo, and then the remainder of the routine then moves it onto the correct face. - -101 FORMAT("ERROR cannot find (i,j) = (", I4, ", ", I4, ") for (a,b,p) = ", I4, ",", I4, ",", I4, ")") -102 FORMAT("i,j,p = ", 3I4, " moved to " 2I4, " (CASE ", I1, ")") - !NOTE: we need the general case to be able to properly handle (0,0), (ncube_reconstruct,0), etc. Note that we don't need to bother with (0,0), etc. when a, b lie in the interior, since both sides of the (0,0) cell are already accounted for by this routine. - !LOWER LEFT - IF (i < 1 .AND. j < 1) THEN - IF (a < 1) THEN !(a,b) centered on left halo, cross to lower halo - inew = 1-j - jnew = i - ELSE IF (b < 1) THEN !(a,b) centered on lower halo, cross to left halo - jnew = 1-i - inew = j - END IF -! WRITE(*,102) i, j, p, inew, jnew, 1 - !LOWER RIGHT - ELSE IF (i > ncube_reconstruct-1 .AND. j < 1) THEN - IF (a > ncube_reconstruct-1) THEN !(a,b) centered on right halo, cross to lower halo - inew = ncube_reconstruct-1+j - jnew = ncube_reconstruct-i - ELSE IF (b < 1) THEN !(a,b) centered on lower halo, cross to right halo - jnew = 1+(i-ncube_reconstruct) - inew = ncube_reconstruct-j - END IF -! WRITE(*,102) i, j, p, inew, jnew, 2 - !UPPER LEFT - ELSE IF (i < 1 .AND. j > ncube_reconstruct-1) THEN - IF (a < 1) THEN! (a,b) centered on left halo, cross to upper halo - inew = 1-(j-ncube_reconstruct) - jnew = ncube_reconstruct-i - ELSE IF (b > ncube_reconstruct-1) THEN !(a,b) centered on upper halo, cross to left halo - inew = ncube_reconstruct-j - jnew = ncube_reconstruct-1-i - END IF -! WRITE(*,102) i, j, p, inew, jnew, 3 - !UPPER RIGHT - ELSE IF (i > ncube_reconstruct-1 .AND. j > ncube_reconstruct-1) THEN - IF (a > ncube_reconstruct-1) THEN !(a,b) centered on right halo, cross to upper halo - inew = ncube_reconstruct-1-(ncube_reconstruct-j) - jnew = i - ELSE IF (b > ncube_reconstruct-1) THEN !(a,b) centered on upper halo, cross to right halo - inew = j - jnew = ncube_reconstruct-1-(ncube_reconstruct-i) - END IF -! WRITE(*,102) i, j, p, inew, jnew, 4 - END IF - - i = inew - j = jnew - - - !Lower halo ("halo" meaning the panel's halo, not the nine-cell halo - IF ((i < 1) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN - IF (p == 1) THEN - value = fcubehalo(ncube_reconstruct-1+i,j,4) - ELSEIF (p == 2) THEN - value = fcubehalo(ncube_reconstruct-1+i,j,1) - ELSEIF (p == 3) THEN - value = fcubehalo(ncube_reconstruct-1+i,j,2) - ELSEIF (p == 4) THEN - value = fcubehalo(ncube_reconstruct-1+i,j,3) - ELSEIF (p == 5) THEN - value = fcubehalo(j,1-i,4) - ELSEIF (p == 6) THEN - value = fcubehalo(ncube_reconstruct-j,ncube_reconstruct-1+i,4) - ENDIF - - !Upper halo - ELSEIF ((i > ncube_reconstruct-1) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN - IF (p == 1) THEN - value = fcubehalo(i-ncube_reconstruct+1,j,2) - ELSEIF (p == 2) THEN - value = fcubehalo(i-ncube_reconstruct+1,j,3) - ELSEIF (p == 3) THEN - value = fcubehalo(i-ncube_reconstruct+1,j,4) - ELSEIF (p == 4) THEN - value = fcubehalo(i-ncube_reconstruct+1,j,1) - ELSEIF (p == 5) THEN - value = fcubehalo(ncube_reconstruct-j,i-ncube_reconstruct+1,2) - ELSEIF (p == 6) THEN - value = fcubehalo(j,2*ncube_reconstruct-i-1,2) - ENDIF - - !Left halo - ELSEIF ((j < 1) .AND. (i > 0) .AND. (i < ncube_reconstruct)) THEN - IF (p == 1) THEN - value = fcubehalo(i,ncube_reconstruct-1+j,5) - ELSEIF (p == 2) THEN - value = fcubehalo(ncube_reconstruct-1+j,ncube_reconstruct-i,5) - ELSEIF (p == 3) THEN - value = fcubehalo(ncube_reconstruct-i,1-j,5) - ELSEIF (p == 4) THEN - value = fcubehalo(1-j,i,5) - ELSEIF (p == 5) THEN - value = fcubehalo(ncube_reconstruct-i,1-j,3) - ELSEIF (p == 6) THEN - value = fcubehalo(i,ncube_reconstruct-1+j,1) - ENDIF - - !Right halo - ELSEIF ((j > ncube_reconstruct-1) .AND. (i > 0) .AND. (i < ncube_reconstruct)) THEN - IF (p == 1) THEN - value = fcubehalo(i,j-ncube_reconstruct+1,6) - ELSEIF (p == 2) THEN - value = fcubehalo(2*ncube_reconstruct-j-1,i,6) - ELSEIF (p == 3) THEN - value = fcubehalo(ncube_reconstruct-i, 2*ncube_reconstruct-j-1,6) - ELSEIF (p == 4) THEN - value = fcubehalo(j-ncube_reconstruct+1,ncube_reconstruct-i,6) - ELSEIF (p == 5) THEN - value = fcubehalo(i,j-ncube_reconstruct+1,1) - ELSEIF (p == 6) THEN - value = fcubehalo(ncube_reconstruct-i, 2*ncube_reconstruct-j-1,3) - ENDIF - - ENDIF - - END IF - min_val = MIN(min_val, value) - max_val = MAX(max_val, value) - ENDDO - ENDDO - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE MonotonizeABPGradient -! -! Description: -! Apply a monotonic filter to the calculated ABP gradient. -! -! Parameters: -! fcubehalo - Scalar field on the cubed sphere to use in reconstruction -! order - Order of the reconstruction -! recons (INOUT) - Array of reconstructed coefficients -! selective - whether to apply a simple form of selective limiting, - !which assumes that if a point is larger/smaller than ALL of its - !surrounding points, that the extremum is physical, and that - !filtering should not be applied to it. -! -! Remarks: -! This monotonizing scheme is based on the monotone scheme for unstructured -! grids of Barth and Jespersen (1989). -!------------------------------------------------------------------------------ - SUBROUTINE MonotonizeABPGradient(fcubehalo, order, recons, selective) - -! USE selective_limiting - - IMPLICIT NONE - - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & - INTENT(IN) :: fcubehalo - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - LOGICAL, INTENT(IN) :: selective - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, k, m, n, skip - - REAL (KIND=dbl_kind) :: local_min, local_max, value, phi, min_phi - REAL (KIND=dbl_kind) :: disc, mx, my, lam, gamma_min, gamma_max - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6) :: & - gamma - - ! The first-order piecewise constant scheme is monotone by construction - IF (order == 1) THEN - RETURN - ENDIF - -! -! xxxxx -! -! IF (selective) THEN -! CALL smoothness2D(fcubehalo, gamma, 2) -! WRITE(*,*) 'gamma range: max ', MAXVAL(gamma), " min ", MINVAL(gamma) -! DO i=1,ncube_reconstruct-1 -! WRITE(*,*) gamma(i, i, 3) -! ENDDO -! skip = 0 -! END IF - - - ! Apply monotone limiting - DO k = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - - - IF (selective) THEN - - CALL ABPHaloMinMax(gamma, i, j, k, gamma_min, gamma_max, .FALSE.) - - IF (gamma_max/(gamma_min + tiny) < lammax) THEN - skip = skip + 1 - CYCLE - END IF - - END IF - - CALL ABPHaloMinMax(fcubehalo, i, j, k, local_min, local_max,.FALSE.) - - - ! Initialize the limiter - min_phi = one - - ! For the second-order calculation, the minima and maxima will occur - ! at the corner points of the element - DO m = i, i+1 - DO n = j, j+1 - - ! Evaluate the function at each corner point - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), gp(n), order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), local_min, local_max, min_phi) - ENDDO - ENDDO - - ! For the third order method, the minima and maxima may occur along - ! the line segments given by du/dx = 0 and du/dy = 0. Also check - ! for the presence of a maxima / minima of the quadratic within - ! the domain. - IF (order == 3) THEN - disc = recons(5,i,j,k)**2 - 4.0 * recons(4,i,j,k) * recons(3,i,j,k) - - ! Check if the quadratic is minimized within the element - IF (ABS(disc) > tiny) THEN - mx = - recons(5,i,j,k) * recons(2,i,j,k) & - + 2.0 * recons(4,i,j,k) * recons(1,i,j,k) - my = - recons(5,i,j,k) * recons(1,i,j,k) & - + 2.0 * recons(3,i,j,k) * recons(2,i,j,k) - - mx = mx / disc + abp_centroid(1,i,j) - my = my / disc + abp_centroid(2,i,j) - - IF ((mx - TAN(gp(i)) > -tiny) .AND. & - (mx - TAN(gp(i+1)) < tiny) .AND. & - (my - TAN(gp(j)) > -tiny) .AND. & - (my - TAN(gp(j+1)) < tiny) & - ) THEN - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), ATAN(my), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDIF - ENDIF - - ! Check all potential minimizer points along element boundaries - IF (ABS(recons(5,i,j,k)) > tiny) THEN - - ! Left/right edge, intercept with du/dx = 0 - DO m = i, i+1 - my = - recons(1,i,j,k) - 2.0 * recons(3,i,j,k) * & - (TAN(gp(m)) - abp_centroid(1,i,j)) - - my = my / recons(5,i,j,k) + abp_centroid(2,i,j) - - IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), ATAN(my), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - - ! Top/bottom edge, intercept with du/dy = 0 - DO n = j, j+1 - mx = - recons(2,i,j,k) - 2.0 * recons(4,i,j,k) * & - (TAN(gp(n)) - abp_centroid(2,i,j)) - - mx = mx / recons(5,i,j,k) + abp_centroid(1,i,j) - - IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - ENDIF - - ! Top/bottom edge, intercept with du/dx = 0 - IF (ABS(recons(3,i,j,k)) > tiny) THEN - DO n = j, j+1 - mx = - recons(1,i,j,k) - recons(5,i,j,k) * & - (TAN(gp(n)) - abp_centroid(2,i,j)) - - mx = mx / (2.0 * recons(3,i,j,k)) + abp_centroid(1,i,j) - - IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - ENDIF - - ! Left/right edge, intercept with du/dy = 0 - IF (ABS(recons(4,i,j,k)) > tiny) THEN - DO m = i, i+1 - my = - recons(2,i,j,k) - recons(5,i,j,k) * & - (TAN(gp(m)) - abp_centroid(1,i,j)) - - my = my / (2.0 * recons(4,i,j,k)) + abp_centroid(2,i,j) - - IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), ATAN(my), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - ENDIF - ENDIF - - IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN - WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' - WRITE (*,*) 'Slope limiter out of range: ', min_phi - STOP - ENDIF - - ! Apply monotone limiter to all reconstruction coefficients - recons(1,i,j,k) = min_phi * recons(1,i,j,k) - recons(2,i,j,k) = min_phi * recons(2,i,j,k) - - IF (order > 2) THEN - recons(3,i,j,k) = min_phi * recons(3,i,j,k) - recons(4,i,j,k) = min_phi * recons(4,i,j,k) - recons(5,i,j,k) = min_phi * recons(5,i,j,k) - ENDIF - ENDDO - ENDDO - ENDDO - - IF (selective) WRITE(*,*) 'skipped ', skip, ' points out of ', 6*(ncube_reconstruct-1)**2 - - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE PosDefABPGradient -! -! Description: -! Scale the reconstructions so they are positive definite -! -! Parameters: -! fcubehalo - Scalar field on the cubed sphere to use in reconstruction -! order - Order of the reconstruction -! recons (INOUT) - Array of reconstructed coefficients -! -! Remarks: -! This monotonizing scheme is based on the monotone scheme for unstructured -! grids of Barth and Jespersen (1989), but simpler. This simply finds the -! minimum and then scales the reconstruction so that it is 0. -!------------------------------------------------------------------------------ - SUBROUTINE PosDefABPGradient(fcubehalo, order, recons) - - IMPLICIT NONE - - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & - INTENT(IN) :: fcubehalo - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, k, m, n - - REAL (KIND=dbl_kind) :: local_min, local_max, value, phi, min_phi - REAL (KIND=dbl_kind) :: disc, mx, my, lam, gamma_min, gamma_max - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6) :: & - gamma - - ! The first-order piecewise constant scheme is monotone by construction - IF (order == 1) THEN - RETURN - ENDIF - - - ! Apply monotone limiting - DO k = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - - !If the average value in the cell is 0.0, then we should skip - !all of the scaling and just set the reconstruction to 0.0 -! IF (ABS(fcubehalo(i,j,k)) < tiny) THEN -! recons(:,i,j,k) = 0.0 -! CYCLE -! END IF - CALL ABPHaloMinMax(fcubehalo, i, j, k, local_min, local_max,.FALSE.) - - - !This allowance for miniscule negative values appearing around the cell being - !filtered/limited. Before this, negative values would be caught in adjust_limiter - !and would stop the model. Doing this only causes minor negative values; no blowing - !up is observed. The rationale is the same as for the monotone filter, which does - !allow miniscule negative values due to roundoff error --- of the order E-10 --- - !in flux-form methods (and E-17 in the s-L method, indicating that roundoff error - !is more severe in the flux-form method, as we expect since we are often subtracting - !2.0 values which are very close together. - local_min = MIN(0.0,local_min) - local_max = bignum !prevents scaling upward; for positive - !definite limiting we don't care about the upper bound - - ! Initialize the limiter - min_phi = one - - ! For the second-order calculation, the minima and maxima will occur - ! at the corner points of the element - DO m = i, i+1 - DO n = j, j+1 - - ! Evaluate the function at each corner point - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), gp(n), order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), local_min, local_max, min_phi) - ENDDO - ENDDO - - ! For the third order method, the minima and maxima may occur along - ! the line segments given by du/dx = 0 and du/dy = 0. Also check - ! for the presence of a maxima / minima of the quadratic within - ! the domain. - IF (order == 3) THEN - disc = recons(5,i,j,k)**2 - 4.0 * recons(4,i,j,k) * recons(3,i,j,k) - - ! Check if the quadratic is minimized within the element - IF (ABS(disc) > tiny) THEN - mx = - recons(5,i,j,k) * recons(2,i,j,k) & - + 2.0 * recons(4,i,j,k) * recons(1,i,j,k) - my = - recons(5,i,j,k) * recons(1,i,j,k) & - + 2.0 * recons(3,i,j,k) * recons(2,i,j,k) - - mx = mx / disc + abp_centroid(1,i,j) - my = my / disc + abp_centroid(2,i,j) - - IF ((mx - TAN(gp(i)) > -tiny) .AND. & - (mx - TAN(gp(i+1)) < tiny) .AND. & - (my - TAN(gp(j)) > -tiny) .AND. & - (my - TAN(gp(j+1)) < tiny) & - ) THEN - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), ATAN(my), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDIF - ENDIF - - ! Check all potential minimizer points along element boundaries - IF (ABS(recons(5,i,j,k)) > tiny) THEN - - ! Left/right edge, intercept with du/dx = 0 - DO m = i, i+1 - my = - recons(1,i,j,k) - 2.0 * recons(3,i,j,k) * & - (TAN(gp(m)) - abp_centroid(1,i,j)) - - my = my / recons(5,i,j,k) + abp_centroid(2,i,j) - - IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), ATAN(my), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - - ! Top/bottom edge, intercept with du/dy = 0 - DO n = j, j+1 - mx = - recons(2,i,j,k) - 2.0 * recons(4,i,j,k) * & - (TAN(gp(n)) - abp_centroid(2,i,j)) - - mx = mx / recons(5,i,j,k) + abp_centroid(1,i,j) - - IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - ENDIF - - ! Top/bottom edge, intercept with du/dx = 0 - IF (ABS(recons(3,i,j,k)) > tiny) THEN - DO n = j, j+1 - mx = - recons(1,i,j,k) - recons(5,i,j,k) * & - (TAN(gp(n)) - abp_centroid(2,i,j)) - - mx = mx / (2.0 * recons(3,i,j,k)) + abp_centroid(1,i,j) - - IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - ENDIF - - ! Left/right edge, intercept with du/dy = 0 - IF (ABS(recons(4,i,j,k)) > tiny) THEN - DO m = i, i+1 - my = - recons(2,i,j,k) - recons(5,i,j,k) * & - (TAN(gp(m)) - abp_centroid(1,i,j)) - - my = my / (2.0 * recons(4,i,j,k)) + abp_centroid(2,i,j) - - IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), ATAN(my), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - ENDIF - ENDIF - - IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN - WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' - WRITE (*,*) 'Slope limiter out of range: ', min_phi - STOP - ENDIF - - ! Apply monotone limiter to all reconstruction coefficients - recons(1,i,j,k) = min_phi * recons(1,i,j,k) - recons(2,i,j,k) = min_phi * recons(2,i,j,k) - - IF (order > 2) THEN - recons(3,i,j,k) = min_phi * recons(3,i,j,k) - recons(4,i,j,k) = min_phi * recons(4,i,j,k) - recons(5,i,j,k) = min_phi * recons(5,i,j,k) - ENDIF - - ENDDO - ENDDO - ENDDO - - - END SUBROUTINE PosDefABPGradient - -!------------------------------------------------------------------------------ -! SUBROUTINE MonotonizeABPGradient_New -! -! Description: -! Apply a monotonic filter to the calculated ABP gradient. -! -! Parameters: -! fcubehalo - Scalar field on the cubed sphere to use in reconstruction -! order - Order of the reconstruction -! recons (INOUT) - Array of reconstructed coefficients -! -! Remarks: -! This monotonizing scheme is similar to the one in MonotonizeABPGradient, -! except the second order derivatives are limited after the first order -! derivatives. -!------------------------------------------------------------------------------ - SUBROUTINE MonotonizeABPGradient_New(fcubehalo, order, recons) - - IMPLICIT NONE - - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & - INTENT(IN) :: fcubehalo - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, k, m, n - - REAL (KIND=dbl_kind) :: local_min, local_max, value, phi, min_phi, linval - REAL (KIND=dbl_kind) :: disc, mx, my - - ! The first-order piecewise constant scheme is monotone by construction - IF (order == 1) THEN - RETURN - ENDIF - - ! Apply monotone limiting - DO k = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - CALL ABPHaloMinMax(fcubehalo, i, j, k, local_min, local_max, .FALSE.) - - ! Initialize the limiter - min_phi = one - - ! For the second-order calculation, the minima and maxima will occur - ! at the corner points of the element - DO m = i, i+1 - DO n = j, j+1 - - ! Evaluate the function at each corner point, only taking into - ! account the linear component of the reconstruction. - value = & - fcubehalo(i,j,k) & - + recons(1,i,j,k) * (TAN(gp(m)) - abp_centroid(1,i,j)) & - + recons(2,i,j,k) * (TAN(gp(n)) - abp_centroid(2,i,j)) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), local_min, local_max, min_phi) - ENDDO - ENDDO - - ! Apply monotone limiter to all reconstruction coefficients - IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN - WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' - WRITE (*,*) 'Slope limiter out of range: ', min_phi - STOP - ENDIF - - recons(1,i,j,k) = min_phi * recons(1,i,j,k) - recons(2,i,j,k) = min_phi * recons(2,i,j,k) - - ! For the third order method, the minima and maxima may occur along - ! the line segments given by du/dx = 0 and du/dy = 0. Also check - ! for the presence of a maxima / minima of the quadratic within - ! the domain. - IF (order == 3) THEN - ! Reset the limiter - min_phi = one - - ! Calculate discriminant, which we use to determine the absolute - ! minima/maxima of the paraboloid - disc = recons(5,i,j,k)**2 - 4.0 * recons(4,i,j,k) * recons(3,i,j,k) - - ! Check if the quadratic is minimized within the element - IF (ABS(disc) > tiny) THEN - mx = - recons(5,i,j,k) * recons(2,i,j,k) & - + 2.0 * recons(4,i,j,k) * recons(1,i,j,k) - my = - recons(5,i,j,k) * recons(1,i,j,k) & - + 2.0 * recons(3,i,j,k) * recons(2,i,j,k) - - mx = mx / disc + abp_centroid(1,i,j) - my = my / disc + abp_centroid(2,i,j) - - IF ((mx - TAN(gp(i)) > -tiny) .AND. & - (mx - TAN(gp(i+1)) < tiny) .AND. & - (my - TAN(gp(j)) > -tiny) .AND. & - (my - TAN(gp(j+1)) < tiny) & - ) THEN - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), ATAN(my), & - order, value) - - linval = & - fcubehalo(i,j,k) & - + recons(1,i,j,k) * (mx - abp_centroid(1,i,j)) & - + recons(2,i,j,k) * (my - abp_centroid(2,i,j)) - - IF (linval < local_min) THEN - linval = local_min - ENDIF - IF (linval > local_max) THEN - linval = local_max - ENDIF - - CALL AdjustLimiter( & - value, linval, local_min, local_max, min_phi) - ENDIF - ENDIF - - ! Check all potential minimizer points along element boundaries - IF (ABS(recons(5,i,j,k)) > tiny) THEN - - ! Left/right edge, intercept with du/dx = 0 - DO m = i, i+1 - my = - recons(1,i,j,k) - 2.0 * recons(3,i,j,k) * & - (TAN(gp(m)) - abp_centroid(1,i,j)) - - my = my / recons(5,i,j,k) + abp_centroid(2,i,j) - - IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), ATAN(my), & - order, value) - - linval = & - fcubehalo(i,j,k) & - + recons(1,i,j,k) * (TAN(gp(m)) - abp_centroid(1,i,j)) & - + recons(2,i,j,k) * (my - abp_centroid(2,i,j)) - - IF (linval < local_min) THEN - linval = local_min - ENDIF - IF (linval > local_max) THEN - linval = local_max - ENDIF - - CALL AdjustLimiter( & - value, linval, local_min, local_max, min_phi) - ENDDO - - ! Top/bottom edge, intercept with du/dy = 0 - DO n = j, j+1 - mx = - recons(2,i,j,k) - 2.0 * recons(4,i,j,k) * & - (TAN(gp(n)) - abp_centroid(2,i,j)) - - mx = mx / recons(5,i,j,k) + abp_centroid(1,i,j) - - IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & - order, value) - - linval = & - fcubehalo(i,j,k) & - + recons(1,i,j,k) * (mx - abp_centroid(1,i,j)) & - + recons(2,i,j,k) * (TAN(gp(n)) - abp_centroid(2,i,j)) - - IF (linval < local_min) THEN - linval = local_min - ENDIF - IF (linval > local_max) THEN - linval = local_max - ENDIF - - CALL AdjustLimiter( & - value, linval, local_min, local_max, min_phi) - ENDDO - ENDIF - - ! Top/bottom edge, intercept with du/dx = 0 - IF (ABS(recons(3,i,j,k)) > tiny) THEN - DO n = j, j+1 - mx = - recons(1,i,j,k) - recons(5,i,j,k) * & - (TAN(gp(n)) - abp_centroid(2,i,j)) - - mx = mx / (2.0 * recons(3,i,j,k)) + abp_centroid(1,i,j) - - IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & - order, value) - - linval = & - fcubehalo(i,j,k) & - + recons(1,i,j,k) * (mx - abp_centroid(1,i,j)) & - + recons(2,i,j,k) * (TAN(gp(n)) - abp_centroid(2,i,j)) - - IF (linval < local_min) THEN - linval = local_min - ENDIF - IF (linval > local_max) THEN - linval = local_max - ENDIF - - CALL AdjustLimiter( & - value, linval, local_min, local_max, min_phi) - ENDDO - ENDIF - - ! Left/right edge, intercept with du/dy = 0 - IF (ABS(recons(4,i,j,k)) > tiny) THEN - DO m = i, i+1 - my = - recons(2,i,j,k) - recons(5,i,j,k) * & - (TAN(gp(m)) - abp_centroid(1,i,j)) - - my = my / (2.0 * recons(4,i,j,k)) + abp_centroid(2,i,j) - - IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), ATAN(my), & - order, value) - - linval = & - fcubehalo(i,j,k) & - + recons(1,i,j,k) * (TAN(gp(m)) - abp_centroid(1,i,j)) & - + recons(2,i,j,k) * (my - abp_centroid(2,i,j)) - - IF (linval < local_min) THEN - linval = local_min - ENDIF - IF (linval > local_max) THEN - linval = local_max - ENDIF - - CALL AdjustLimiter( & - value, linval, local_min, local_max, min_phi) - ENDDO - ENDIF - - ! For the second-order calculation, the minima and maxima will occur - ! at the corner points of the element - DO m = i, i+1 - DO n = j, j+1 - - ! Evaluate the function at each corner point - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), gp(n), & - order, value) - - linval = & - fcubehalo(i,j,k) & - + recons(1,i,j,k) * (TAN(gp(m)) - abp_centroid(1,i,j)) & - + recons(2,i,j,k) * (TAN(gp(n)) - abp_centroid(2,i,j)) - - IF (linval < local_min) THEN - linval = local_min - ENDIF - IF (linval > local_max) THEN - linval = local_max - ENDIF - - CALL AdjustLimiter( & - value, linval, local_min, local_max, min_phi) - ENDDO - ENDDO - - IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN - WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' - WRITE (*,*) 'Slope limiter out of range: ', min_phi - STOP - ENDIF - - WRITE (*,*) '2: ', min_phi - - recons(1,i,j,k) = min_phi * recons(1,i,j,k) - recons(2,i,j,k) = min_phi * recons(2,i,j,k) - recons(3,i,j,k) = min_phi * recons(3,i,j,k) - recons(4,i,j,k) = min_phi * recons(4,i,j,k) - recons(5,i,j,k) = min_phi * recons(5,i,j,k) - ENDIF - ENDDO - ENDDO - ENDDO - - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE ReconstructABPGradient_NEL -! -! Description: -! Construct a non-equidistant linear reconstruction of the gradient -! within each element on an ABP grid. -! -! Parameters: -! fcubehalo - Scalar field on the ABP grid to use in reconstruction -! recons (OUT) - Array of reconstructed coefficients for total elements -! order - Order of the scheme (2 or 3) -!------------------------------------------------------------------------------ - SUBROUTINE ReconstructABPGradient_NEL(fcubehalo, recons, order) - -! USE CubedSphereTrans -! USE InterpolateCSLL_Utils - - IMPLICIT NONE - - REAL (KIND=dbl_kind), & - DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), INTENT(IN) :: fcubehalo - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(OUT) :: recons - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, p - - REAL (KIND=dbl_kind) :: alpha1, alpha2, beta1, beta2 - REAL (KIND=dbl_kind) :: dx_left, dx_right, top_value, bot_value - - DO p = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - dx_left = abp_centroid(1,i-1,j) - abp_centroid(1,i,j) - dx_right = abp_centroid(1,i+1,j) - abp_centroid(1,i,j) - - recons(1,i,j,p) = & - (+ fcubehalo(i-1,j,p) * dx_right**2 & - - fcubehalo(i+1,j,p) * dx_left**2 & - - fcubehalo(i,j,p) * (dx_right**2 - dx_left**2)) / & - (dx_right * dx_left * (dx_right - dx_left)) - - dx_left = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) - dx_right = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) - - recons(2,i,j,p) = & - (+ fcubehalo(i,j-1,p) * dx_right**2 & - - fcubehalo(i,j+1,p) * dx_left**2 & - - fcubehalo(i,j,p) * (dx_right**2 - dx_left**2)) / & - (dx_right * dx_left * (dx_right - dx_left)) - - IF (order > 2) THEN - dx_left = abp_centroid(1,i-1,j) - abp_centroid(1,i,j) - dx_right = abp_centroid(1,i+1,j) - abp_centroid(1,i,j) - - recons(3,i,j,p) = & - (+ fcubehalo(i-1,j,p) * dx_right & - - fcubehalo(i+1,j,p) * dx_left & - - fcubehalo(i,j,p) * (dx_right - dx_left)) / & - (dx_right * dx_left * (dx_left - dx_right)) - - dx_left = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) - dx_right = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) - - recons(4,i,j,p) = & - (+ fcubehalo(i,j-1,p) * dx_right & - - fcubehalo(i,j+1,p) * dx_left & - - fcubehalo(i,j,p) * (dx_right - dx_left)) / & - (dx_right * dx_left * (dx_left - dx_right)) - ENDIF - ENDDO - ENDDO - - IF (order > 2) THEN - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - dx_left = abp_centroid(1,i-1,j+1) - abp_centroid(1,i,j+1) - dx_right = abp_centroid(1,i+1,j+1) - abp_centroid(1,i,j+1) - - top_value = & - (+ fcubehalo(i-1,j+1,p) * dx_right**2 & - - fcubehalo(i+1,j+1,p) * dx_left**2 & - - fcubehalo(i,j+1,p) * (dx_right**2 - dx_left**2)) / & - (dx_right * dx_left * (dx_right - dx_left)) - - dx_left = abp_centroid(1,i-1,j-1) - abp_centroid(1,i,j-1) - dx_right = abp_centroid(1,i+1,j-1) - abp_centroid(1,i,j-1) - - bot_value = & - (+ fcubehalo(i-1,j-1,p) * dx_right**2 & - - fcubehalo(i+1,j-1,p) * dx_left**2 & - - fcubehalo(i,j-1,p) * (dx_right**2 - dx_left**2)) / & - (dx_right * dx_left * (dx_right - dx_left)) - - dx_left = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) - dx_right = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) - - recons(5,i,j,p) = & - (+ bot_value * dx_right**2 & - - top_value * dx_left**2 & - - recons(1,i,j,p) * (dx_right**2 - dx_left**2)) / & - (dx_right * dx_left * (dx_right - dx_left)) - - ENDDO - ENDDO - ENDIF - ENDDO - - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE ReconstructABPGradient_NEP -! -! Description: -! Construct a non-equidistant parabolic reconstruction of the gradient -! within each element on an ABP grid. -! -! Parameters: -! fcubehalo - Scalar field on the ABP grid to use in reconstruction -! recons (OUT) - Array of reconstructed coefficients for total elements -! order - Order of the scheme (2 or 3) -!------------------------------------------------------------------------------ - SUBROUTINE ReconstructABPGradient_NEP(fcubehalo, recons, order) - - -! USE CubedSphereTrans -! USE InterpolateCSLL_Utils - - IMPLICIT NONE - - REAL (KIND=dbl_kind), & - DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), INTENT(IN) :: fcubehalo - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(OUT) :: recons - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, p - - REAL (KIND=dbl_kind) :: x1, x2, x4, x5, y1, y2, y3, y4, y5 - - REAL (KIND=dbl_kind), DIMENSION(5) :: t, pa, denom - - DO p = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - ! X-direction reconstruction - x1 = abp_centroid(1,i-2,j) - abp_centroid(1,i,j) - x2 = abp_centroid(1,i-1,j) - abp_centroid(1,i,j) - x4 = abp_centroid(1,i+1,j) - abp_centroid(1,i,j) - x5 = abp_centroid(1,i+2,j) - abp_centroid(1,i,j) - - !IF (i == 1) THEN - ! x1 = piq - !ELSEIF (i == ncube_reconstruct-1) THEN - ! x5 = -piq - !ENDIF - - y1 = fcubehalo(i-2,j,p) - y2 = fcubehalo(i-1,j,p) - y3 = fcubehalo(i,j,p) - y4 = fcubehalo(i+1,j,p) - y5 = fcubehalo(i+2,j,p) - - denom(1) = (x2 - x1) * (x4 - x1) * (x5 - x1) * x1 - denom(2) = (x1 - x2) * (x4 - x2) * (x5 - x2) * x2 - denom(4) = (x1 - x4) * (x2 - x4) * (x5 - x4) * x4 - denom(5) = (x1 - x5) * (x2 - x5) * (x4 - x5) * x5 - - t(1) = x5 * x4 * x2 - t(2) = x5 * x4 * x1 - t(4) = x5 * x2 * x1 - t(5) = x4 * x2 * x1 - t(3) = (t(1) + t(2) + t(4) + t(5)) / (x1 * x2 * x4 * x5) - - pa(1) = x2 * x4 + x2 * x5 + x4 * x5 - pa(2) = x1 * x4 + x1 * x5 + x4 * x5 - pa(4) = x1 * x2 + x1 * x5 + x2 * x5 - pa(5) = x1 * x2 + x1 * x4 + x2 * x4 - pa(3) = (pa(1) + pa(2) + pa(4) + pa(5)) / (2.0 * x1 * x2 * x4 * x5) - - recons(1,i,j,p) = & - + y1 * t(1) / denom(1) & - + y2 * t(2) / denom(2) & - - y3 * t(3) & - + y4 * t(4) / denom(4) & - + y5 * t(5) / denom(5) - - IF (order > 2) THEN - recons(3,i,j,p) = & - - y1 * pa(1) / denom(1) & - - y2 * pa(2) / denom(2) & - + y3 * pa(3) & - - y4 * pa(4) / denom(4) & - - y5 * pa(5) / denom(5) - ENDIF - - ! Y-direction reconstruction - x1 = abp_centroid(2,i,j-2) - abp_centroid(2,i,j) - x2 = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) - x4 = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) - x5 = abp_centroid(2,i,j+2) - abp_centroid(2,i,j) - - !IF (j == 1) THEN - ! x1 = piq - !ELSEIF (j == ncube_reconstruct-1) THEN - ! x5 = -piq - !ENDIF - - y1 = fcubehalo(i,j-2,p) - y2 = fcubehalo(i,j-1,p) - y3 = fcubehalo(i,j,p) - y4 = fcubehalo(i,j+1,p) - y5 = fcubehalo(i,j+2,p) - - denom(1) = (x2 - x1) * (x4 - x1) * (x5 - x1) * x1 - denom(2) = (x1 - x2) * (x4 - x2) * (x5 - x2) * x2 - denom(4) = (x1 - x4) * (x2 - x4) * (x5 - x4) * x4 - denom(5) = (x1 - x5) * (x2 - x5) * (x4 - x5) * x5 - - t(1) = x5 * x4 * x2 - t(2) = x5 * x4 * x1 - t(4) = x5 * x2 * x1 - t(5) = x4 * x2 * x1 - t(3) = (t(1) + t(2) + t(4) + t(5)) / (x1 * x2 * x4 * x5) - - pa(1) = x2 * x4 + x2 * x5 + x4 * x5 - pa(2) = x1 * x4 + x1 * x5 + x4 * x5 - pa(4) = x1 * x2 + x1 * x5 + x2 * x5 - pa(5) = x1 * x2 + x1 * x4 + x2 * x4 - pa(3) = (pa(1) + pa(2) + pa(4) + pa(5)) / (2.0 * x1 * x2 * x4 * x5) - - recons(2,i,j,p) = & - + y1 * t(1) / denom(1) & - + y2 * t(2) / denom(2) & - - y3 * t(3) & - + y4 * t(4) / denom(4) & - + y5 * t(5) / denom(5) - - IF (order > 2) THEN - recons(4,i,j,p) = & - - y1 * pa(1) / denom(1) & - - y2 * pa(2) / denom(2) & - + y3 * pa(3) & - - y4 * pa(4) / denom(4) & - - y5 * pa(5) / denom(5) - recons(5,i,j,p) = 0.0 - ENDIF - - ENDDO - ENDDO - IF (order > 2) THEN - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - x1 = abp_centroid(1,i-1,j+1) - abp_centroid(1,i,j+1) - x2 = abp_centroid(1,i+1,j+1) - abp_centroid(1,i,j+1) - - y2 = (+ fcubehalo(i-1,j+1,p) * x2**2 & - - fcubehalo(i+1,j+1,p) * x1**2 & - - fcubehalo(i,j+1,p) * (x2**2 - x1**2)) / & - (x2 * x1 * (x2 - x1)) - - x1 = abp_centroid(1,i-1,j-1) - abp_centroid(1,i,j-1) - x2 = abp_centroid(1,i+1,j-1) - abp_centroid(1,i,j-1) - - y1 = (+ fcubehalo(i-1,j-1,p) * x2**2 & - - fcubehalo(i+1,j-1,p) * x1**2 & - - fcubehalo(i,j-1,p) * (x2**2 - x1**2)) / & - (x2 * x1 * (x2 - x1)) - - x1 = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) - x2 = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) - - recons(5,i,j,p) = & - (+ y1 * x2**2 & - - y2 * x1**2 & - - recons(1,i,j,p) * (x2**2 - x1**2)) / & - (x2 * x1 * (x2 - x1)) - - ENDDO - ENDDO - ENDIF - ENDDO - - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE ReconstructABPGradient_PLM -! -! Description: -! Construct a piecewise linear reconstruction of the gradient within -! each element on an ABP grid. -! -! Parameters: -! fcubehalo - Scalar field on the ABP grid to use in reconstruction -! recons (OUT) - Array of reconstructed coefficients for total elements -! order - Order of the scheme (2 or 3) -!------------------------------------------------------------------------------ - SUBROUTINE ReconstructABPGradient_PLM(fcubehalo, recons, order) - -! USE CubedSphereTrans -! USE InterpolateCSLL_Utils - - IMPLICIT NONE - - REAL (KIND=dbl_kind), & - DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), INTENT(IN) :: fcubehalo - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(OUT) :: recons - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, p - - REAL (KIND=dbl_kind) :: width - - ! ABP width between elements - width = pih / DBLE(ncube_reconstruct-1) - - DO p = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - ! df/dx - recons(1,i,j,p) = (fcubehalo(i+1,j,p) - fcubehalo(i-1,j,p)) / & - (2.0 * width) - - ! df/dy - recons(2,i,j,p) = (fcubehalo(i,j+1,p) - fcubehalo(i,j-1,p)) / & - (2.0 * width) - - ! Stretching - recons(1,i,j,p) = recons(1,i,j,p) / (one + abp_centroid(1,i,j)**2) - recons(2,i,j,p) = recons(2,i,j,p) / (one + abp_centroid(2,i,j)**2) - - ! Third order scheme - IF (order > 2) THEN - ! d^2f/dx^2 - recons(3,i,j,p) = & - (fcubehalo(i+1,j,p) - 2.0 * fcubehalo(i,j,p) & - + fcubehalo(i-1,j,p)) / (width * width) - - ! d^2f/dy^2 - recons(4,i,j,p) = & - (fcubehalo(i,j+1,p) - 2.0 * fcubehalo(i,j,p) & - + fcubehalo(i,j-1,p)) / (width * width) - - ! d^2f/dxdy - recons(5,i,j,p) = & - (+ fcubehalo(i+1,j+1,p) - fcubehalo(i-1,j+1,p) & - - fcubehalo(i+1,j-1,p) + fcubehalo(i-1,j-1,p) & - ) / (4.0 * width * width) - - ! Stretching - recons(3,i,j,p) = & - (- 2.0 * abp_centroid(1,i,j) * (one + abp_centroid(1,i,j)**2) * recons(1,i,j,p) & - + recons(3,i,j,p)) / (one + abp_centroid(1,i,j)**2)**2 - - recons(4,i,j,p) = & - (- 2.0 * abp_centroid(2,i,j) * (one + abp_centroid(2,i,j)**2) * recons(2,i,j,p) & - + recons(4,i,j,p)) / (one + abp_centroid(2,i,j)**2)**2 - - recons(5,i,j,p) = recons(5,i,j,p) / & - ((one + abp_centroid(1,i,j)**2) * (one + abp_centroid(2,i,j)**2)) - - ! Scaling - recons(3,i,j,p) = 0.5 * recons(3,i,j,p) - recons(4,i,j,p) = 0.5 * recons(4,i,j,p) - - ENDIF - ENDDO - ENDDO - ENDDO - - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE ReconstructABPGradient_PPM -! -! Description: -! Construct a piecewise parabolic reconstruction of the gradient within -! each element on an ABP grid. -! -! Parameters: -! fcubehalo - Scalar field on the ABP grid to use in reconstruction -! recons (OUT) - Array of reconstructed coefficients for total elements -! order - Order of the scheme (2 or 3) -!------------------------------------------------------------------------------ - SUBROUTINE ReconstructABPGradient_PPM(fcubehalo, recons, order) - - -! USE CubedSphereTrans -! USE InterpolateCSLL_Utils - - IMPLICIT NONE - - REAL (KIND=dbl_kind), & - DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), INTENT(IN) :: fcubehalo - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(OUT) :: recons - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, p - - REAL (KIND=dbl_kind) :: width - - ! ABP width between elements - width = pih / DBLE(ncube_reconstruct-1) - - DO p = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - ! df/dalfa - recons(1,i,j,p) = & - (+ fcubehalo(i+2,j,p) - 8.0 * fcubehalo(i+1,j,p) & - + 8.0 * fcubehalo(i-1,j,p) - fcubehalo(i-2,j,p)) / & - (- 12.0 * width) - - ! df/dbeta - recons(2,i,j,p) = & - (+ fcubehalo(i,j+2,p) - 8.0 * fcubehalo(i,j+1,p) & - + 8.0 * fcubehalo(i,j-1,p) - fcubehalo(i,j-2,p)) / & - (- 12.0 * width) - - ! Stretching - recons(1,i,j,p) = recons(1,i,j,p) / (one + abp_centroid(1,i,j)**2) - recons(2,i,j,p) = recons(2,i,j,p) / (one + abp_centroid(2,i,j)**2) - - ! Third order scheme - IF (order > 2) THEN - ! d^2f/dx^2 - recons(3,i,j,p) = (- fcubehalo(i+2,j,p) & - + 16_dbl_kind * fcubehalo(i+1,j,p) & - - 30_dbl_kind * fcubehalo(i,j,p) & - + 16_dbl_kind * fcubehalo(i-1,j,p) & - - fcubehalo(i-2,j,p) & - ) / (12_dbl_kind * width**2) - - ! d^2f/dy^2 - recons(4,i,j,p) = (- fcubehalo(i,j+2,p) & - + 16_dbl_kind * fcubehalo(i,j+1,p) & - - 30_dbl_kind * fcubehalo(i,j,p) & - + 16_dbl_kind * fcubehalo(i,j-1,p) & - - fcubehalo(i,j-2,p) & - ) / (12_dbl_kind * width**2) - - ! d^2f/dxdy - recons(5,i,j,p) = & - (+ fcubehalo(i+1,j+1,p) - fcubehalo(i-1,j+1,p) & - - fcubehalo(i+1,j-1,p) + fcubehalo(i-1,j-1,p) & - ) / (4.0 * width * width) - - ! Stretching - recons(3,i,j,p) = & - (- 2.0 * abp_centroid(1,i,j) * (one + abp_centroid(1,i,j)**2) * recons(1,i,j,p) & - + recons(3,i,j,p)) / (one + abp_centroid(1,i,j)**2)**2 - - recons(4,i,j,p) = & - (- 2.0 * abp_centroid(2,i,j) * (one + abp_centroid(2,i,j)**2) * recons(2,i,j,p) & - + recons(4,i,j,p)) / (one + abp_centroid(2,i,j)**2)**2 - - recons(5,i,j,p) = recons(5,i,j,p) / & - ((one + abp_centroid(1,i,j)**2) * (one + abp_centroid(2,i,j)**2)) - - ! Scaling - recons(3,i,j,p) = 0.5 * recons(3,i,j,p) - recons(4,i,j,p) = 0.5 * recons(4,i,j,p) - ENDIF - ENDDO - ENDDO - ENDDO - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE ReconstructABPGradient -! -! Description: -! Compute the reconstructed gradient in gnomonic coordinates for each -! ABP element. -! -! Parameters: -! fcube - Scalar field on the cubed sphere to use in reconstruction -! halomethod - Method for computing halo elements -! (0) Piecewise constant -! (1) Piecewise linear -! (3) Piecewise cubic -! recons_method - Method for computing the sub-grid scale gradient -! (0) Non-equidistant linear reconstruction -! (1) Non-equidistant parabolic reconstruction -! (2) Piecewise linear reconstruction with stretching -! (3) Piecewise parabolic reconstruction with stretching -! order - Order of the method being applied -! kmono - Apply monotone limiting (1) or not (0) -! recons (INOUT) - Array of reconstructed coefficients -!------------------------------------------------------------------------------ - SUBROUTINE ReconstructABPGradient( & - fcube, halomethod, recons_method, order, kmono, recons, kpd, kscheme) - -! USE InterpolateCSLL_Utils - - IMPLICIT NONE - - REAL (KIND=dbl_kind), & - DIMENSION(1:ncube_reconstruct-1, 1:ncube_reconstruct-1, 6), INTENT(IN) :: fcube - - INTEGER (KIND=int_kind), INTENT(IN) :: halomethod, recons_method - INTEGER (KIND=int_kind), INTENT(IN) :: order, kmono, kpd, kscheme - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, p - - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6) :: fcubehalo - - ! Report status - WRITE (*,*) '...Performing sub-grid scale reconstruction on ABP grid' - - ! Compute element haloes - WRITE(*,*) "fill cubed-sphere halo for reconstruction" - DO p = 1, 6 - IF (halomethod == 0) THEN - CALL CubedSphereFillHalo(fcube, fcubehalo, p, ncube_reconstruct, 2) - - ELSEIF (halomethod == 1) THEN - CALL CubedSphereFillHalo_Linear(fcube, fcubehalo, p, ncube_reconstruct) - - ELSEIF (halomethod == 3) THEN - !halomethod is always 3 in the standard CSLAM setup - CALL CubedSphereFillHalo_Cubic(fcube, fcubehalo, p, ncube_reconstruct) - ELSE - WRITE (*,*) 'Fatal Error: In ReconstructABPGradient' - WRITE (*,*) 'Invalid halo method: ', halomethod - WRITE (*,*) 'Halo method must be 0, 1 or 3.' - STOP - ENDIF - ENDDO - - ! Nonequidistant linear reconstruction - IF (recons_method == 1) THEN - CALL ReconstructABPGradient_NEL(fcubehalo, recons, order) - - ! Nonequidistant parabolic reconstruction (JCP paper) - ELSEIF (recons_method == 2) THEN - WRITE(*,*) "Nonequidistant parabolic reconstruction" - CALL ReconstructABPGradient_NEP(fcubehalo, recons, order) - - ! Piecewise linear reconstruction with rotation - ELSEIF (recons_method == 3) THEN - CALL ReconstructABPGradient_PLM(fcubehalo, recons, order) - - ! Piecewise parabolic reconstruction with rotation - ELSEIF (recons_method == 4) THEN - CALL ReconstructABPGradient_PPM(fcubehalo, recons, order) - - ELSE - WRITE(*,*) 'Fatal Error: In ReconstructABPGradient' - WRITE(*,*) 'Specified recons_method out of range. Given: ', recons_method - WRITE(*,*) 'Valid values: 1, 2, 3, 4' - STOP - ENDIF - - ! Apply monotone filtering - SELECT CASE (kmono) - CASE (0) !Do nothing - WRITE(*,*) "no filter applied to the reconstruction" - CASE (1) - - !Simplest filter: just scales the recon so it's extreme value - !is no bigger than the original values of this point and its neighbors - CALL MonotonizeABPGradient(fcubehalo, order, recons, .FALSE.) - - CASE (2) - - !Applies a more sophisticated Van Leer limiter (or, to be consistent, a filter) - CALL VanLeerLimit(fcubehalo, order, recons) - - CASE (3) - - !Applies a selective filter - CALL MonotonizeABPGradient(fcubehalo, order, recons, .TRUE.) - - CASE (4) - - !A filter that filters the linear part first - CALL MonotonizeABPGradient_New(fcubehalo, order, recons) - - CASE DEFAULT - WRITE(*,*) "Limiter kmono = ", kmono, " does not exist." - STOP 1201 - - END SELECT - - !Apply positive-definite filtering, if desired. This should - !ONLY be applied to the S-L method, since the flux-form - !method needs something different done. (In particular, using - !positive-definite reconstructions does not ensure that a flux- - !form scheme is positive definite, since we could get negatives - !when subtracting the resulting fluxes.) - !HOWEVER...we will allow this to be enabled, for testing purposes - IF ( (kpd > 0 .AND. kscheme == 2) .OR. (kpd == 2 .AND. kscheme == 4) ) THEN - WRITE(*,*) "applying positive deifnite constraint" - CALL PosDefABPGradient(fcubehalo, order, recons) - END IF - - - END SUBROUTINE - - - -!------------------------------------------------------------------------------ -!------------------------------------------------------------------------------ -! SUBROUTINE AdjustLimiter -! -! Description: -! Adjust the slope limiter based on new point values. -! -! Parameters: -! value - Point value -! element_value - Value at the center of the element -! local_max - Local maximum value of the function (from neighbours) -! local_min - Local minimum value of the function (to neighbours) -! min_phi (INOUT) - Slope limiter -!------------------------------------------------------------------------------ - SUBROUTINE AdjustLimiter(value, element_value, local_min, local_max, min_phi) - - IMPLICIT NONE - - REAL (KIND=dbl_kind), INTENT(IN) :: value, element_value - REAL (KIND=dbl_kind), INTENT(IN) :: local_min, local_max - REAL (KIND=dbl_kind), INTENT(INOUT) :: min_phi - - ! Local variables - REAL (KIND=dbl_kind) :: phi = 0.0 - - IF ((local_min > element_value ) .OR. (local_max < element_value )) THEN - WRITE (*,*) 'Fatal Error: In AdjustLimiter' - WRITE (*,*) 'Local min: ', local_min, ' max: ', local_max - WRITE (*,*) 'Elemn: ', element_value - STOP - ENDIF - - ! Check against the minimum bound on the reconstruction - IF (value - element_value > tiny * value) THEN - phi = (local_max - element_value) / & - (value - element_value) - - min_phi = MIN(min_phi, phi) - - ! Check against the maximum bound on the reconstruction - ELSEIF (value - element_value < -tiny * value) THEN - phi = (local_min - element_value) / & - (value - element_value) - - min_phi = MIN(min_phi, phi) - - ENDIF - - IF (min_phi < 0.0) THEN - WRITE (*,*) 'Fatal Error: In AdjustLimiter' - WRITE (*,*) 'Min_Phi: ', min_phi - WRITE (*,*) 'Phi: ', phi - WRITE (*,*) 'Value: ', value - WRITE (*,*) 'Elemn: ', element_value - WRITE (*,*) 'Val-E: ', value - element_value - STOP - ENDIF - - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE VanLeerLimit -! -! Description: -! Apply a 2D Van Leer-type limiter to a reconstruction. This acts ONLY -! on the linear part of the reconstruction , if any. If passed a PCoM -! reconstruction, this just returns without altering the recon. -! -! Parameters: -! fcubehalo - Scalar field on the cubed sphere to use in reconstruction -! order - Order of the reconstruction -! recons (INOUT) - Array of reconstructed coefficients -! -! Remarks: -! The Van Leer Limiter described here is given on pages 328--329 -! of Dukowicz and Baumgardner (2000). There are no guarantees -! on what it will do to PPM. -!------------------------------------------------------------------------------ - SUBROUTINE VanLeerLimit(fcubehalo, order, recons) - - - IMPLICIT NONE - - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & - INTENT(IN) :: fcubehalo - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, k, m, n - - REAL (KIND=dbl_kind) :: local_min, local_max, value, phi, min_phi, & - recon_min, recon_max - - ! The first-order piecewise constant scheme is monotone by construction - IF (order == 1) THEN - RETURN - ENDIF - - ! Apply monotone limiting - DO k = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - CALL ABPHaloMinMax(fcubehalo, i, j, k, local_min, local_max,.FALSE.) - - ! Initialize the limiter - min_phi = one - - ! For the second-order calculation, the minima and maxima will occur - ! at the corner points of the element. For the Van Leer limiter, we - !wish to find BOTH of the reconstruction extrema. - recon_min = bignum - recon_max = -bignum - - DO m = i, i+1 - DO n = j, j+1 - - ! Evaluate the function at each corner point - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), gp(n), order, value) - recon_min = MIN(recon_min, value) - recon_max = MAX(recon_max, value) - - ENDDO - ENDDO - - !This is equation 27 in Dukowicz and Baumgardner 2000 - min_phi = MIN(one, MAX(0.0, (local_min - fcubehalo(i,j,k))/(recon_min - fcubehalo(i,j,k))), & - MAX(0.0, (local_max - fcubehalo(i,j,k))/(recon_max - fcubehalo(i,j,k))) ) - - IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN - WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' - WRITE (*,*) 'Slope limiter out of range: ', min_phi - STOP - ENDIF - - ! Apply monotone limiter to all reconstruction coefficients - recons(1,i,j,k) = min_phi * recons(1,i,j,k) - recons(2,i,j,k) = min_phi * recons(2,i,j,k) - - END DO - END DO - END DO - - - - - END SUBROUTINE VanLeerLimit - - !------------------------------------------------------------------------------ - ! SUBROUTINE EquiangularElementArea - ! - ! Description: - ! Compute the area of a single equiangular cubed sphere grid cell. - ! - ! Parameters: - ! alpha - Alpha coordinate of lower-left corner of grid cell - ! da - Delta alpha - ! beta - Beta coordinate of lower-left corner of grid cell - ! db - Delta beta - !------------------------------------------------------------------------------ - REAL(KIND=dbl_kind) FUNCTION EquiangularElementArea(alpha, da, beta, db) - - IMPLICIT NONE - -! REAL (kind=dbl_kind) :: EquiangularElementArea - REAL (kind=dbl_kind) :: alpha, da, beta, db - REAL (kind=dbl_kind) :: a1, a2, a3, a4 - - ! Calculate interior grid angles - a1 = EquiangularGridAngle(alpha , beta ) - a2 = pi - EquiangularGridAngle(alpha+da, beta ) - a3 = pi - EquiangularGridAngle(alpha , beta+db) - a4 = EquiangularGridAngle(alpha+da, beta+db) - - ! Area = r*r*(-2*pi+sum(interior angles)) - EquiangularElementArea = -pi2 + a1 + a2 + a3 + a4 - - END FUNCTION EquiangularElementArea - - !------------------------------------------------------------------------------ - ! FUNCTION EquiangularGridAngle - ! - ! Description: - ! Compute the angle between equiangular cubed sphere projection grid lines. - ! - ! Parameters: - ! alpha - Alpha coordinate of evaluation point - ! beta - Beta coordinate of evaluation point - !------------------------------------------------------------------------------ - REAL(KIND=dbl_kind) FUNCTION EquiangularGridAngle(alpha, beta) - IMPLICIT NONE - REAL (kind=dbl_kind) :: alpha, beta - EquiangularGridAngle = ACOS(-SIN(alpha) * SIN(beta)) - END FUNCTION EquiangularGridAngle - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereFillHalo -! -! Description: -! Recompute the cubed sphere data storage array, with the addition of a -! halo region around the specified panel. -! -! Parameters: -! parg - Current panel values -! zarg (OUT) - Calculated panel values with halo/ghost region -! np - Panel number -! ncube - Dimension of the cubed sphere (# of grid lines) -! nhalo - Number of halo/ghost elements around each panel -!------------------------------------------------------------------------------ - SUBROUTINE CubedSphereFillHalo(parg, zarg, np, ncube, nhalo) - - IMPLICIT NONE - - REAL (KIND=dbl_kind), DIMENSION(ncube-1, ncube-1, 6), INTENT(IN) :: parg - - REAL (KIND=dbl_kind), & - DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6), & - INTENT(OUT) :: zarg - - INTEGER (KIND=int_kind), INTENT(IN) :: np, ncube,nhalo - - ! Local variables - INTEGER (KIND=int_kind) :: jh,jhy - - !zarg = 0.0 !DBG - zarg(1:ncube-1,1:ncube-1,np) = parg(1:ncube-1,1:ncube-1,np) - - zarg(1-nhalo:0,1-nhalo:0,np) = 0.0 - zarg(1-nhalo:0,ncube:ncube+nhalo-1,np) = 0.0 - zarg(ncube:ncube+nhalo-1,1-nhalo:0,np) = 0.0 - zarg(ncube:ncube+nhalo-1,ncube:ncube+nhalo-1,np) = 0.0 - - ! Equatorial panels - IF (np==1) THEN - DO jh=1,nhalo - zarg(ncube+jh-1,1:ncube-1 ,1) = parg(jh ,1:ncube-1 ,2) !exchange right - zarg(1-jh ,1:ncube-1 ,1) = parg(ncube-jh ,1:ncube-1 ,4) !exchange left - zarg(1:ncube-1 ,1-jh ,1) = parg(1:ncube-1 ,ncube-jh ,5) !exchange below - zarg(1:ncube-1 ,ncube+jh-1,1) = parg(1:ncube-1 ,jh ,6) !exchange over - ENDDO - - ELSE IF (np==2) THEN - DO jh=1,nhalo - zarg(1-jh ,1:ncube-1 ,2) = parg(ncube-jh,1:ncube-1 ,1) !exchange left - zarg(ncube+jh-1,1:ncube-1 ,2) = parg(jh ,1:ncube-1 ,3) !exchange right - zarg(1:ncube-1 ,1-jh ,2) = parg(ncube-jh,ncube-1:1:-1,5) !exchange below - zarg(1:ncube-1 ,ncube+jh-1,2) = parg(ncube-jh,1:ncube-1 ,6) !exchange over - ENDDO - - ELSE IF (np==3) THEN - DO jh=1,nhalo - zarg(ncube+jh-1,1:ncube-1 ,3) = parg(jh ,1:ncube-1,4) !exchange right - zarg(1-jh ,1:ncube-1 ,3) = parg(ncube-jh ,1:ncube-1,2) !exchange left - zarg(1:ncube-1 ,1-jh ,3) = parg(ncube-1:1:-1,jh ,5) !exchange below - zarg(1:ncube-1 ,ncube+jh-1,3) = parg(ncube-1:1:-1,ncube-jh ,6) !exchange over - ENDDO - - ELSE IF (np==4) THEN - DO jh=1,nhalo - zarg(1-jh ,1:ncube-1 ,4) = parg(ncube-jh,1:ncube-1 ,3) !exchange left - zarg(ncube+jh-1,1:ncube-1 ,4) = parg(jh ,1:ncube-1 ,1) !exchange right - zarg(1:ncube-1 ,1-jh ,4) = parg(jh ,1:ncube-1 ,5) !exchange below - zarg(1:ncube-1 ,ncube+jh-1,4) = parg(jh ,ncube-1:1:-1,6) !exchange over - ENDDO - - ! Bottom panel - ELSE IF (np==5) THEN - DO jh=1,nhalo - zarg(1-jh ,1:ncube-1 ,5) = parg(1:ncube-1 ,jh ,4) !exchange left - zarg(ncube+jh-1,1:ncube-1 ,5) = parg(ncube-1:1:-1,jh ,2) !exchange right - zarg(1:ncube-1 ,1-jh ,5) = parg(ncube-1:1:-1,jh ,3) !exchange below - zarg(1:ncube-1 ,ncube+jh-1,5) = parg(1:ncube-1 ,jh ,1) !exchange over - ENDDO - - ! Top panel - ELSE IF (np==6) THEN - DO jh=1,nhalo - zarg(1-jh ,1:ncube-1 ,6) = parg(ncube-1:1:-1,ncube-jh,4) !exchange left - zarg(ncube+jh-1,1:ncube-1 ,6) = parg(1:ncube-1 ,ncube-jh,2) !exchange right - zarg(1:ncube-1 ,1-jh ,6) = parg(1:ncube-1 ,ncube-jh,1) !exchange below - zarg(1:ncube-1 ,ncube+jh-1,6) = parg(ncube-1:1:-1,ncube-jh,3) !exchange over - ENDDO - - ELSE - WRITE (*,*) 'Fatal error: In CubedSphereFillHalo' - WRITE (*,*) 'Invalid panel id ', np - STOP - ENDIF - - END SUBROUTINE CubedSphereFillHalo - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereFillHalo_Linear -! -! Description: -! Recompute the cubed sphere data storage array, with the addition of a -! 2-element halo region around the specified panel. Use linear order -! interpolation to translate between panels. -! -! Parameters: -! parg - Current panel values -! zarg (OUT) - Calculated panel values with halo/ghost region -! np - Panel number -! ncube - Dimension of the cubed sphere (# of grid lines) -!------------------------------------------------------------------------------ - SUBROUTINE CubedSphereFillHalo_Linear(parg, zarg, np, ncube) - -! USE CubedSphereTrans ! Cubed sphere transforms - - IMPLICIT NONE - - INTEGER (KIND=int_kind), PARAMETER :: nhalo = 2 - - REAL (KIND=dbl_kind), DIMENSION(ncube-1, ncube-1, 6), INTENT(IN) :: parg - - REAL (KIND=dbl_kind), & - DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6), & - INTENT(OUT) :: zarg - - INTEGER (KIND=int_kind), INTENT(IN) :: np, ncube - - ! Local variables - INTEGER (KIND=int_kind) :: ii, iref, jj, ipanel, imin, imax - REAL (KIND=dbl_kind) :: width, lon, lat, beta, a, newbeta - - REAL (KIND=dbl_kind), DIMENSION(0:ncube, nhalo) :: prealpha - REAL (KIND=dbl_kind), DIMENSION(0:ncube, nhalo) :: newalpha - - REAL (KIND=dbl_kind), & - DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6) :: yarg - - ! Use 0.0 order interpolation to begin - CALL CubedSphereFillHalo(parg, yarg, np, ncube, nhalo) - - zarg(:,:,np) = yarg(:,:,np) - - ! Calculate the overlapping alpha coordinates - width = pih / DBLE(ncube-1) - - DO jj = 1, nhalo - DO ii = 0, ncube - prealpha(ii, jj) = width * (DBLE(ii-1) + 0.5) - piq - beta = - width * (DBLE(jj-1) + 0.5) - piq - - CALL CubedSphereABPFromABP(prealpha(ii,jj), beta, 1, 5, & - newalpha(ii,jj), newbeta) - ENDDO - ENDDO - - ! Now apply linear interpolation to obtain edge components - DO jj = 1, nhalo - ! Reset the reference index - iref = 2 - - ! Interpolation can be applied to more elements after first band - IF (jj == 1) THEN - imin = 1 - imax = ncube-1 - ELSE - imin = 0 - imax = ncube - ENDIF - - ! Apply linear interpolation - DO ii = imin, imax - DO WHILE ((iref .NE. ncube-1) .AND. & - (newalpha(ii,jj) > prealpha(iref,jj))) - iref = iref + 1 - ENDDO - - IF ((newalpha(ii,jj) > prealpha(iref-1,jj)) .AND. & - (newalpha(ii,jj) .LE. prealpha(iref ,jj))) & - THEN - a = (newalpha(ii,jj) - prealpha(iref-1,jj)) / & - (prealpha(iref,jj) - prealpha(iref-1,jj)) - - IF ((a < 0.0) .OR. (a > one)) THEN - WRITE (*,*) 'FAIL in CubedSphereFillHalo_Linear' - WRITE (*,*) 'a out of bounds' - STOP - ENDIF - - ! Bottom edge of panel - zarg(ii, 1-jj, np) = & - (one - a) * yarg(iref-1, 1-jj, np) + & - a * yarg(iref, 1-jj, np) - - ! Left edge of panel - zarg(1-jj, ii, np) = & - (one - a) * yarg(1-jj, iref-1, np) + & - a * yarg(1-jj, iref, np) - - ! Top edge of panel - zarg(ii, ncube+jj-1, np) = & - (one - a) * yarg(iref-1, ncube+jj-1, np) + & - a * yarg(iref, ncube+jj-1, np) - - ! Right edge of panel - zarg(ncube+jj-1, ii, np) = & - (one - a) * yarg(ncube+jj-1, iref-1, np) + & - a * yarg(ncube+jj-1, iref, np) - - ELSE - WRITE (*,*) 'FAIL in CubedSphereFillHalo_Linear' - WRITE (*,*) 'ii: ', ii, ' jj: ', jj - WRITE (*,*) 'newalpha: ', newalpha(ii,jj) - WRITE (*,*) 'prealpha: ', prealpha(iref-1,jj), '-', prealpha(iref,jj) - STOP - ENDIF - ENDDO - ENDDO - - ! Fill in corner bits - zarg(0, 0, np) = & - 0.25 * (zarg(1,0,np) + zarg(0,1,np) + & - zarg(-1,0,np) + zarg(0,-1,np)) - zarg(0, ncube, np) = & - 0.25 * (zarg(0,ncube-1,np) + zarg(0,ncube+1,np) + & - zarg(-1,ncube,np) + zarg(1,ncube,np)) - zarg(ncube, 0, np) = & - 0.25 * (zarg(ncube-1,0,np) + zarg(ncube+1,0,np) + & - zarg(ncube,-1,np) + zarg(ncube,1,np)) - zarg(ncube, ncube, np) = & - 0.25 * (zarg(ncube-1,ncube,np) + zarg(ncube+1,ncube,np) + & - zarg(ncube,ncube-1,np) + zarg(ncube,ncube+1,np)) - - END SUBROUTINE CubedSphereFillHalo_Linear - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereFillHalo_Cubic -! -! Description: -! Recompute the cubed sphere data storage array, with the addition of a -! 2-element halo region around the specified panel. Use higher order -! interpolation to translate between panels. -! -! Parameters: -! parg - Current panel values -! zarg (OUT) - Calculated panel values with halo/ghost region -! np - Panel number -! ncube - Dimension of the cubed sphere (# of grid lines) -!------------------------------------------------------------------------------ - SUBROUTINE CubedSphereFillHalo_Cubic(parg, zarg, np, ncube) - -! USE CubedSphereTrans ! Cubed sphere transforms -! USE MathUtils ! Has function for 1D cubic interpolation - - IMPLICIT NONE - - INTEGER (KIND=int_kind), PARAMETER :: nhalo = 2 - - REAL (KIND=dbl_kind), DIMENSION(ncube-1, ncube-1, 6), INTENT(IN) :: parg - - REAL (KIND=dbl_kind), & - DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6), & - INTENT(OUT) :: zarg - - INTEGER (KIND=int_kind), INTENT(IN) :: np, ncube - - ! Local variables - INTEGER (KIND=int_kind) :: ii, iref, ibaseref, jj, ipanel, imin, imax - REAL (KIND=dbl_kind) :: width, lon, lat, beta, a, newbeta - - REAL (KIND=dbl_kind), DIMENSION(0:ncube, nhalo) :: prealpha - REAL (KIND=dbl_kind), DIMENSION(0:ncube, nhalo) :: newalpha - REAL (KIND=dbl_kind), DIMENSION(1:4) :: C, D, X - - REAL (KIND=dbl_kind), & - DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6) :: yarg - - ! Use 0.0 order interpolation to begin - CALL CubedSphereFillHalo(parg, yarg, np, ncube, nhalo) - - zarg(:,:,np) = yarg(:,:,np) - - ! Calculate the overlapping alpha coordinates - width = pih / DBLE(ncube-1) - - DO jj = 1, nhalo - DO ii = 0, ncube - ! - ! alpha,beta for the cell center (extending the panel) - ! - prealpha(ii, jj) = width * (DBLE(ii-1) + 0.5) - piq - beta = - width * (DBLE(jj-1) + 0.5) - piq - - CALL CubedSphereABPFromABP(prealpha(ii,jj), beta, 1, 5, & - newalpha(ii,jj), newbeta) - ENDDO - ENDDO - - ! Now apply cubic interpolation to obtain edge components - DO jj = 1, nhalo - ! Reset the reference index, which gives the element in newalpha that - ! is closest to ii, looking towards larger values of alpha. - iref = 2 - - ! Interpolation can be applied to more elements after first band -! IF (jj == 1) THEN -! imin = 1 -! imax = ncube-1 -! ELSE - imin = 0 - imax = ncube -! ENDIF - - ! Apply cubic interpolation - DO ii = imin, imax - DO WHILE ((iref .NE. ncube-1) .AND. & - (newalpha(ii,jj) > prealpha(iref,jj))) - iref = iref + 1 - ENDDO - - ! Smallest index for cubic interpolation - apply special consideration - IF (iref == 2) THEN - ibaseref = iref-1 - - ! Largest index for cubic interpolation - apply special consideration - ELSEIF (iref == ncube-1) THEN - ibaseref = iref-3 - - ! Normal range - ELSE - ibaseref = iref-2 - ENDIF - - ! Bottom edge of panel - zarg(ii, 1-jj, np) = & - CUBIC_EQUISPACE_INTERP( & - width, newalpha(ii,jj) - prealpha(ibaseref,jj), & - yarg(ibaseref:ibaseref+3, 1-jj, np)) - - ! Left edge of panel - zarg(1-jj, ii, np) = & - CUBIC_EQUISPACE_INTERP( & - width, newalpha(ii,jj) - prealpha(ibaseref,jj), & - yarg(1-jj, ibaseref:ibaseref+3, np)) - - ! Top edge of panel - zarg(ii, ncube+jj-1, np) = & - CUBIC_EQUISPACE_INTERP( & - width, newalpha(ii,jj) - prealpha(ibaseref,jj), & - yarg(ibaseref:ibaseref+3, ncube+jj-1, np)) - - ! Right edge of panel - zarg(ncube+jj-1, ii, np) = & - CUBIC_EQUISPACE_INTERP( & - width, newalpha(ii,jj) - prealpha(ibaseref,jj), & - yarg(ncube+jj-1, ibaseref:ibaseref+3, np)) - - ENDDO - ENDDO - - ! Fill in corner bits - zarg(0, 0, np) = & - 0.25 * (zarg(1,0,np) + zarg(0,1,np) + & - zarg(-1,0,np) + zarg(0,-1,np)) - zarg(0, ncube, np) = & - 0.25 * (zarg(0,ncube-1,np) + zarg(0,ncube+1,np) + & - zarg(-1,ncube,np) + zarg(1,ncube,np)) - zarg(ncube, 0, np) = & - 0.25 * (zarg(ncube-1,0,np) + zarg(ncube+1,0,np) + & - zarg(ncube,-1,np) + zarg(ncube,1,np)) - zarg(ncube, ncube, np) = & - 0.25 * (zarg(ncube-1,ncube,np) + zarg(ncube+1,ncube,np) + & - zarg(ncube,ncube-1,np) + zarg(ncube,ncube+1,np)) - - END SUBROUTINE CubedSphereFillHalo_Cubic - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereABPFromABP -! -! Description: -! Determine the (alpha,beta,idest) coordinate of a source point on -! panel isource. -! -! Parameters: -! alpha_in - Alpha coordinate in -! beta_in - Beta coordinate in -! isource - Source panel -! idest - Destination panel -! alpha_out (OUT) - Alpha coordinate out -! beta_out (OUT) - Beta coordiante out -!------------------------------------------------------------------------------ - SUBROUTINE CubedSphereABPFromABP(alpha_in, beta_in, isource, idest, & - alpha_out, beta_out) - - IMPLICIT NONE - - REAL (KIND=dbl_kind), INTENT(IN) :: alpha_in, beta_in - INTEGER (KIND=int_kind), INTENT(IN) :: isource, idest - REAL (KIND=dbl_kind), INTENT(OUT) :: alpha_out, beta_out - - ! Local variables - REAL (KIND=dbl_kind) :: a1, b1 - REAL (KIND=dbl_kind) :: xx, yy, zz - REAL (KIND=dbl_kind) :: sx, sy, sz - - ! Convert to relative Cartesian coordinates - a1 = TAN(alpha_in) - b1 = TAN(beta_in) - - sz = (one + a1 * a1 + b1 * b1)**(-0.5) - sx = sz * a1 - sy = sz * b1 - - ! Convert to full Cartesian coordinates - IF (isource == 6) THEN - yy = sx; xx = -sy; zz = sz - - ELSEIF (isource == 5) THEN - yy = sx; xx = sy; zz = -sz - - ELSEIF (isource == 1) THEN - yy = sx; zz = sy; xx = sz - - ELSEIF (isource == 3) THEN - yy = -sx; zz = sy; xx = -sz - - ELSEIF (isource == 2) THEN - xx = -sx; zz = sy; yy = sz - - ELSEIF (isource == 4) THEN - xx = sx; zz = sy; yy = -sz - - ELSE - WRITE(*,*) 'Fatal Error: Source panel invalid in CubedSphereABPFromABP' - WRITE(*,*) 'panel = ', isource - STOP - ENDIF - - ! Convert to relative Cartesian coordinates on destination panel - IF (idest == 6) THEN - sx = yy; sy = -xx; sz = zz - - ELSEIF (idest == 5) THEN - sx = yy; sy = xx; sz = -zz - - ELSEIF (idest == 1) THEN - sx = yy; sy = zz; sz = xx - - ELSEIF (idest == 3) THEN - sx = -yy; sy = zz; sz = -xx - - ELSEIF (idest == 2) THEN - sx = -xx; sy = zz; sz = yy - - ELSEIF (idest == 4) THEN - sx = xx; sy = zz; sz = -yy - - ELSE - WRITE(*,*) 'Fatal Error: Dest panel invalid in CubedSphereABPFromABP' - WRITE(*,*) 'panel = ', idest - STOP - ENDIF - IF (sz < 0) THEN - WRITE(*,*) 'Fatal Error: In CubedSphereABPFromABP' - WRITE(*,*) 'Invalid relative Z coordinate' - STOP - ENDIF - - ! Use panel information to calculate (alpha, beta) coords - alpha_out = ATAN(sx / sz) - beta_out = ATAN(sy / sz) - - END SUBROUTINE - - -!------------------------------------------------------------------------------ -! FUNCTION CUBIC_EQUISPACE_INTERP -! -! Description: -! Apply cubic interpolation on the specified array of values, where all -! points are equally spaced. -! -! Parameters: -! dx - Spacing of points -! x - X coordinate where interpolation is to be applied -! y - Array of 4 values = f(x + k * dx) where k = 0,1,2,3 -!------------------------------------------------------------------------------ - FUNCTION CUBIC_EQUISPACE_INTERP(dx, x, y) - - IMPLICIT NONE - - REAL (KIND=dbl_kind) :: CUBIC_EQUISPACE_INTERP - REAL (KIND=dbl_kind) :: dx, x - REAL (KIND=dbl_kind), DIMENSION(1:4) :: y - - CUBIC_EQUISPACE_INTERP = & - (-y(1) / (6.0 * dx**3)) * (x - dx) * (x - 2.0 * dx) * (x - 3.0 * dx) + & - ( y(2) / (2.0 * dx**3)) * (x) * (x - 2.0 * dx) * (x - 3.0 * dx) + & - (-y(3) / (2.0 * dx**3)) * (x) * (x - dx) * (x - 3.0 * dx) + & - ( y(4) / (6.0 * dx**3)) * (x) * (x - dx) * (x - 2.0 * dx) - - END FUNCTION CUBIC_EQUISPACE_INTERP - -! FUNCTION I_10_ab(alpha,beta) -! IMPLICIT NONE -! REAL (KIND=dbl_kind) :: I_10_AB -! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta -! I_10_ab = -ASINH(COS(alpha) * TAN(beta)) -! END FUNCTION I_10_AB -!! -! -! REAL (KIND=dbl_kind) FUNCTION I_01_ab(alpha,beta) -! IMPLICIT NONE -! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta -! I_01_ab = -ASINH(COS(beta) * TAN(alpha)) -! END FUNCTION I_01_AB -! -! REAL (KIND=dbl_kind) FUNCTION I_20_ab(alpha,beta) -! IMPLICIT NONE -! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta -! -! I_20_ab = TAN(beta)*ASINH(COS(beta)*TAN(alpha))+ACOS(SIN(alpha)*SIN(beta)) -! END FUNCTION I_20_AB -! -! REAL (KIND=dbl_kind) FUNCTION I_02_ab(alpha,beta) -! IMPLICIT NONE -! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta -! -! I_02_ab = TAN(alpha)*ASINH(TAN(beta)*COS(alpha))+ACOS(SIN(alpha)*SIN(beta)) -! END FUNCTION I_02_AB -! -! REAL (KIND=dbl_kind) FUNCTION I_11_ab(alpha,beta) -! IMPLICIT NONE -! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta -! -! I_11_ab = -SQRT(1.0+TAN(alpha)**2+TAN(beta)**2) -! END FUNCTION I_11_AB -! - - -END MODULE reconstruct - diff --git a/tools/topo_tool/cube_to_target/remap.F90 b/tools/topo_tool/cube_to_target/remap.F90 deleted file mode 100644 index b56b7fd493..0000000000 --- a/tools/topo_tool/cube_to_target/remap.F90 +++ /dev/null @@ -1,1561 +0,0 @@ -MODULE remap - INTEGER, PARAMETER :: & - int_kind = KIND(1), & - real_kind = SELECTED_REAL_KIND(p=14,r=100),& - dbl_kind = selected_real_kind(13) - - INTEGER :: nc,nhe - -! LOGICAL, PARAMETER:: ldbgr_r = .FALSE. - LOGICAL :: ldbgr - LOGICAL :: ldbg_global - - REAL(kind=real_kind), PARAMETER :: & - one = 1.0 ,& - aa = 1.0 ,& - tiny= 1.0E-9 ,& - bignum = 1.0E20 - REAL (KIND=dbl_kind), parameter :: fuzzy_width = 10.0*tiny !CAM-SE add - - contains - - - subroutine compute_weights_cell(xcell_in,ycell_in,jx,jy,nreconstruction,xgno,ygno,& - jx_min, jx_max, jy_min, jy_max,tmp,& - ngauss,gauss_weights,abscissae,weights,weights_eul_index,jcollect,jmax_segments,& - nc_in,nhe_in,nvertex,ldbg) - - implicit none - integer (kind=int_kind) , intent(in):: nreconstruction, jx,jy,ngauss,jmax_segments - real (kind=real_kind) , dimension(0:nvertex+1) :: xcell_in,ycell_in -! real (kind=real_kind) , dimension(0:5), intent(in):: xcell_in,ycell_in - integer (kind=int_kind), intent(in) :: nc_in,nhe_in,nvertex - logical, intent(in) :: ldbg - ! - ! ipanel is just for debugging - ! - integer (kind=int_kind), intent(in) :: jx_min, jy_min, jx_max, jy_max - real (kind=real_kind), dimension(-nhe_in:nc_in+2+nhe_in), intent(in) :: xgno - real (kind=real_kind), dimension(-nhe_in:nc_in+2+nhe_in), intent(in) :: ygno - ! - ! for Gaussian quadrature - ! - real (kind=real_kind), dimension(ngauss), intent(in) :: gauss_weights, abscissae - ! - ! boundaries of domain - ! - real (kind=real_kind):: tmp - ! - ! Number of Eulerian sub-cell integrals for the cell in question - ! - integer (kind=int_kind), intent(out) :: jcollect - ! - ! local workspace - ! - ! - ! max number of line segments is: - ! - ! (number of longitudes)*(max average number of crossings per line segment = 3)*ncube*2 - ! - real (kind=real_kind) , & - dimension(jmax_segments,nreconstruction), intent(out) :: weights - integer (kind=int_kind), & - dimension(jmax_segments,2), intent(out) :: weights_eul_index - - real (kind=real_kind), dimension(0:3) :: x,y - integer (kind=int_kind),dimension(0:5) :: jx_eul, jy_eul - integer (kind=int_kind) :: jsegment,i - ! - ! variables for registering crossings with Eulerian latitudes and longitudes - ! - integer (kind=int_kind) :: jcross_lat, iter - ! - ! max. crossings per side is 2*nhe - ! - real (kind=real_kind), & - dimension(jmax_segments,2) :: r_cross_lat - integer (kind=int_kind), & - dimension(jmax_segments,2) :: cross_lat_eul_index - real (kind=real_kind) , dimension(1:nvertex) :: xcell,ycell - - real (kind=real_kind) :: eps - - ldbg_global = ldbg - ldbgr = ldbg - - nc = nc_in - nhe = nhe_in - - xcell = xcell_in(1:nvertex) - ycell = ycell_in(1:nvertex) - - - ! - ! this is to avoid ill-conditioning problems - ! - eps = 1.0E-9 - - jsegment = 0 - weights = 0.0D0 - jcross_lat = 0 - ! - !********************** - ! - ! Integrate cell sides - ! - !********************** - - - IF (jx<-nhe.OR.jx>nc+1+nhe.OR.jy<-nhe.OR.jy>nc+1+nhe) THEN - WRITE(*,*) "jx,jy,-nhe,nc+1+nhe",jx,jy,-nhe,nc+1+nhe - STOP - END IF - - - call side_integral(xcell,ycell,nvertex,jsegment,jmax_segments,& - weights,weights_eul_index,nreconstruction,jx,jy,xgno,ygno,jx_min, jx_max, jy_min, jy_max,& - ngauss,gauss_weights,abscissae,& - jcross_lat,r_cross_lat,cross_lat_eul_index) - - ! - !********************** - ! - ! Do inner integrals - ! - !********************** - ! - call compute_inner_line_integrals_lat_nonconvex(r_cross_lat,cross_lat_eul_index,& - jcross_lat,jsegment,jmax_segments,xgno,jx_min, jx_max, jy_min, jy_max,& - weights,weights_eul_index,& - nreconstruction,ngauss,gauss_weights,abscissae) - ! - ! collect line-segment that reside in the same Eulerian cell - ! - if (jsegment>0) then - call collect(weights,weights_eul_index,nreconstruction,jcollect,jsegment,jmax_segments) - ! - ! DBG - ! - tmp=0.0 - do i=1,jcollect - tmp=tmp+weights(i,1) - enddo - - IF (abs(tmp)>0.01) THEN - WRITE(*,*) "sum of weights too large",tmp - stop - END IF - IF (tmp<-1.0E-9) THEN - WRITE(*,*) "sum of weights is negative - negative area?",tmp,jx,jy - ! ldbgr=.TRUE. - stop - END IF - else - jcollect = 0 - end if - end subroutine compute_weights_cell - - - ! - !**************************************************************************** - ! - ! organize data and store it - ! - !**************************************************************************** - ! - subroutine collect(weights,weights_eul_index,nreconstruction,jcollect,jsegment,jmax_segments) - implicit none - integer (kind=int_kind) , intent(in) :: nreconstruction - real (kind=real_kind) , dimension(jmax_segments,nreconstruction), intent(inout) :: weights - integer (kind=int_kind), dimension(jmax_segments,2 ), intent(inout) :: weights_eul_index - integer (kind=int_kind), INTENT(OUT ) :: jcollect - integer (kind=int_kind), INTENT(IN ) :: jsegment,jmax_segments - ! - ! local workspace - ! - integer (kind=int_kind) :: imin, imax, jmin, jmax, i,j,k,h - logical :: ltmp - - real (kind=real_kind) , dimension(jmax_segments,nreconstruction) :: weights_out - integer (kind=int_kind), dimension(jmax_segments,2 ) :: weights_eul_index_out - - weights_out = 0.0D0 - weights_eul_index_out = -100 - - imin = MINVAL(weights_eul_index(1:jsegment,1)) - imax = MAXVAL(weights_eul_index(1:jsegment,1)) - jmin = MINVAL(weights_eul_index(1:jsegment,2)) - jmax = MAXVAL(weights_eul_index(1:jsegment,2)) - - ltmp = .FALSE. - - jcollect = 1 - - do j=jmin,jmax - do i=imin,imax - do k=1,jsegment - if (weights_eul_index(k,1)==i.AND.weights_eul_index(k,2)==j) then - weights_out(jcollect,1:nreconstruction) = & - weights_out(jcollect,1:nreconstruction) + weights(k,1:nreconstruction) - ltmp = .TRUE. - h = k - endif - enddo - if (ltmp) then - weights_eul_index_out(jcollect,:) = weights_eul_index(h,:) - jcollect = jcollect+1 - endif - ltmp = .FALSE. - enddo - enddo - jcollect = jcollect-1 - weights = weights_out - weights_eul_index = weights_eul_index_out - end subroutine collect - ! - !***************************************************************************************** - ! - ! - ! - !***************************************************************************************** - ! - subroutine compute_inner_line_integrals_lat(r_cross_lat,cross_lat_eul_index,& - jcross_lat,jsegment,jmax_segments,xgno,jx_min,jx_max,jy_min, jy_max,weights,weights_eul_index,& - nreconstruction,ngauss,gauss_weights,abscissae)!phl add jx_min etc. - implicit none - ! - ! for Gaussian quadrature - ! - real (kind=real_kind), dimension(ngauss), intent(in) :: gauss_weights, abscissae - ! - ! variables for registering crossings with Eulerian latitudes and longitudes - ! - integer (kind=int_kind), intent(in):: jcross_lat, jmax_segments,nreconstruction,ngauss - integer (kind=int_kind), intent(inout):: jsegment - ! - ! max. crossings per side is 2*nhe - ! - real (kind=real_kind), & - dimension(jmax_segments,2), intent(in):: r_cross_lat - integer (kind=int_kind), & - dimension(jmax_segments,2), intent(in):: cross_lat_eul_index - integer (kind=int_kind), intent(in) ::jx_min, jx_max, jy_min, jy_max - real (kind=real_kind), dimension(-nhe:nc+2+nhe), intent(in) :: xgno - real (kind=real_kind) , & - dimension(jmax_segments,nreconstruction), intent(inout) :: weights - integer (kind=int_kind), & - dimension(jmax_segments,2), intent(inout) :: weights_eul_index - real (kind=real_kind) , dimension(nreconstruction) :: weights_tmp - - integer (kind=int_kind) :: imin, imax, jmin, jmax, i,j,k, isgn, h, eul_jx, eul_jy - integer (kind=int_kind) :: idx_start_y,idx_end_y - logical :: ltmp,lcontinue - real (kind=real_kind), dimension(2) :: rstart,rend,rend_tmp - real (kind=real_kind), dimension(2) :: xseg, yseg -5 FORMAT(10e14.6) - - - if (jcross_lat>0) then - do i=MINVAL(cross_lat_eul_index(1:jcross_lat,2)),MAXVAL(cross_lat_eul_index(1:jcross_lat,2)) - ! - ! find "first" crossing with Eulerian cell i - ! - do k=1,jcross_lat - if (cross_lat_eul_index(k,2)==i) exit - enddo - do j=k+1,jcross_lat - ! - ! find "second" crossing with Eulerian cell i - ! - if (cross_lat_eul_index(j,2)==i) then - if (r_cross_lat(k,1)0) then - do i=MINVAL(cross_lat_eul_index(1:jcross_lat,2)),MAXVAL(cross_lat_eul_index(1:jcross_lat,2)) - ! WRITE(*,*) "looking at latitude ",i !xxxx - count = 1 - ! - ! find all crossings with Eulerian latitude i - ! - do k=1,jcross_lat - if (cross_lat_eul_index(k,2)==i) then - ! WRITE(*,*) "other crossings with latitude",i ," is ",k!xxxx - r_cross_lat_seg (count,:) = r_cross_lat (k,:) - cross_lat_eul_index_seg(count,:) = cross_lat_eul_index(k,:) - - IF (ldbg_global) then - WRITE(*,*) r_cross_lat_seg(count,1),r_cross_lat_seg(count,2) - WRITE(*,*) " " - END IF - count = count+1 - end if - enddo - count = count-1 - IF (ABS((count/2)-DBLE(count)/2.0)1000) THEN - WRITE(*,*) "search not converging",iter - STOP - END IF - lsame_cell_x = (x(2).GE.xgno(jx_eul).AND.x(2).LE.xgno(jx_eul+1)) - lsame_cell_y = (y(2).GE.ygno(jy_eul).AND.y(2).LE.ygno(jy_eul+1)) -! IF (ldbgr) WRITE(*,*) "lsame_cell_x,lsame_cell_y=",lsame_cell_x,lsame_cell_y - IF (lsame_cell_x.AND.lsame_cell_y) THEN - ! - !**************************** - ! - ! same cell integral - ! - !**************************** - ! -! IF (ldbgr) WRITE(*,*) "same cell integral",jx_eul,jy_eul - xseg(1) = x(1); yseg(1) = y(1); xseg(2) = x(2); yseg(2) = y(2) - jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; - lcontinue = .FALSE. - ! - ! prepare for next side if (x(2),y(2)) is on a grid line - ! - IF (x(2).EQ.xgno(jx_eul+1).AND.x(3)>xgno(jx_eul+1)) THEN - ! - ! cross longitude jx_eul+1 - ! -! IF (ldbgr) WRITE(*,*) "cross longitude",jx_eul+1 - jx_eul=jx_eul+1 - ELSE IF (x(2).EQ.xgno(jx_eul ).AND.x(3)ygno(jy_eul+1)) THEN - ! - ! register crossing with latitude: line-segments point Northward - ! - jcross_lat = jcross_lat + 1 - jy_eul = jy_eul + 1 -! IF (ldbgr) WRITE(*,*) "cross latitude",jy_eul - cross_lat_eul_index(jcross_lat,1) = jx_eul - cross_lat_eul_index(jcross_lat,2) = jy_eul - r_cross_lat(jcross_lat,1) = x(2) - r_cross_lat(jcross_lat,2) = y(2) - ELSE IF (y(2).EQ.ygno(jy_eul ).AND.y(3)y(1) else "0" - ysgn2 = INT(SIGN(1.0D0,y(2)-y(1))) !"1" if y(2)>y(1) else "-1" - ! - !******************************************************************************* - ! - ! there is at least one crossing with latitudes but no crossing with longitudes - ! - !******************************************************************************* - ! - yeul = ygno(jy_eul+ysgn1) - IF (x(1).EQ.x(2)) THEN - ! - ! line segment is parallel to longitude (infinite slope) - ! -! IF (ldbgr) WRITE(*,*) "line segment parallel to longitude" - xcross = x(1) - ELSE - slope = (y(2)-y(1))/(x(2)-x(1)) - xcross = x_cross_eul_lat(x(1),y(1),yeul,slope) - ! - ! constrain crossing to be "physically" possible - ! - xcross = MIN(MAX(xcross,xgno(jx_eul)),xgno(jx_eul+1)) - - -! IF (ldbgr) WRITE(*,*) "cross latitude" - ! - ! debugging - ! - IF (xcross.GT.xgno(jx_eul+1).OR.xcross.LT.xgno(jx_eul)) THEN - WRITE(*,*) "xcross is out of range",jx,jy - WRITE(*,*) "xcross-xgno(jx_eul+1), xcross-xgno(jx_eul))",& - xcross-xgno(jx_eul+1), xcross-ygno(jx_eul) - STOP - END IF - END IF - xseg(1) = x(1); yseg(1) = y(1); xseg(2) = xcross; yseg(2) = yeul - jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; - ! - ! prepare for next iteration - ! - x(0) = x(1); y(0) = y(1); x(1) = xcross; y(1) = yeul; jy_eul = jy_eul+ysgn2 - ! - ! register crossing with latitude - ! - jcross_lat = jcross_lat+1 - cross_lat_eul_index(jcross_lat,1) = jx_eul - if (ysgn2>0) then - cross_lat_eul_index(jcross_lat,2) = jy_eul - else - cross_lat_eul_index(jcross_lat,2) = jy_eul+1 - end if - r_cross_lat(jcross_lat,1) = xcross - r_cross_lat(jcross_lat,2) = yeul - ELSE IF (lsame_cell_y) THEN -! IF (ldbgr) WRITE(*,*) "same cell y" - ! - !******************************************************************************* - ! - ! there is at least one crossing with longitudes but no crossing with latitudes - ! - !******************************************************************************* - ! - xsgn1 = (1+INT(SIGN(1.0D0,x(2)-x(1))))/2 !"1" if x(2)>x(1) else "0" - xsgn2 = INT(SIGN(1.0D0,x(2)-x(1))) !"1" if x(2)>x(1) else "-1" - xeul = xgno(jx_eul+xsgn1) -! IF (ldbgr) WRITE(*,*) " crossing longitude",jx_eul+xsgn1 - IF (ABS(x(2)-x(1))x(1) else "0" - xsgn2 = (INT(SIGN(1.0D0,x(2)-x(1)))) !"1" if x(2)>x(1) else "0" - xeul = xgno(jx_eul+xsgn1) - ysgn1 = (1+INT(SIGN(1.0D0,y(2)-y(1))))/2 !"1" if y(2)>y(1) else "0" - ysgn2 = INT(SIGN(1.0D0,y(2)-y(1))) !"1" if y(2)>y(1) else "-1" - yeul = ygno(jy_eul+ysgn1) - - slope = (y(2)-y(1))/(x(2)-x(1)) - IF (ABS(x(2)-x(1))0.AND.xcross.LE.xeul).OR.(xsgn2<0.AND.xcross.GE.xeul)) THEN - ! - ! cross latitude - ! -! IF (ldbgr) WRITE(*,*) "crossing latitude",jy_eul+ysgn1 - xseg(1) = x(1); yseg(1) = y(1); xseg(2) = xcross; yseg(2) = yeul - jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; - ! - ! prepare for next iteration - ! - x(0) = x(1); y(0) = y(1); x(1) = xcross; y(1) = yeul; jy_eul = jy_eul+ysgn2 - ! - ! register crossing with latitude - ! - jcross_lat = jcross_lat+1 - cross_lat_eul_index(jcross_lat,1) = jx_eul - if (ysgn2>0) then - cross_lat_eul_index(jcross_lat,2) = jy_eul - else - cross_lat_eul_index(jcross_lat,2) = jy_eul+1 - end if - r_cross_lat(jcross_lat,1) = xcross - r_cross_lat(jcross_lat,2) = yeul - ELSE - ! - ! cross longitude - ! -! IF (ldbgr) WRITE(*,*) "crossing longitude",jx_eul+xsgn1 - xseg(1) = x(1); yseg(1) = y(1); xseg(2) = xeul; yseg(2) = ycross - jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; - ! - ! prepare for next iteration - ! - x(0) = x(1); y(0) = y(1); x(1) = xeul; y(1) = ycross; jx_eul = jx_eul+xsgn2 - END IF - - END IF - END IF - ! - ! register line-segment (don't register line-segment if outside of panel) - ! - if (jx_eul_tmp>=jx_min.AND.jy_eul_tmp>=jy_min.AND.& - jx_eul_tmp<=jx_max-1.AND.jy_eul_tmp<=jy_max-1) then - ! jx_eul_tmp<=jx_max-1.AND.jy_eul_tmp<=jy_max-1.AND.side_count<3) then - jsegment=jsegment+1 - weights_eul_index(jsegment,1) = jx_eul_tmp - weights_eul_index(jsegment,2) = jy_eul_tmp - call get_weights_gauss(weights(jsegment,1:nreconstruction),& - xseg,yseg,nreconstruction,ngauss,gauss_weights,abscissae) - -! if (ldbg_global) then -! OPEN(unit=40, file='side_integral.dat',status='old',access='append') -! WRITE(40,*) xseg(1),yseg(1) -! WRITE(40,*) xseg(2),yseg(2) -! WRITE(40,*) " " -! CLOSE(40) -! end if - - - jdbg=jdbg+1 - - if (xseg(1).EQ.xseg(2))then - slope = bignum - else if (abs(yseg(1) -yseg(2))0) THEN - compute_slope = (y(2)-y(1))/(x(2)-x(1)) - else - compute_slope = bignum - end if - end function compute_slope - - real (kind=real_kind) function y_cross_eul_lon(x,y,xeul,slope) - implicit none - real (kind=real_kind), intent(in) :: x,y - real (kind=real_kind) , intent(in) :: xeul,slope - ! line: y=a*x+b - real (kind=real_kind) :: a,b - b = y-slope*x - y_cross_eul_lon = slope*xeul+b - end function y_cross_eul_lon - - real (kind=real_kind) function x_cross_eul_lat(x,y,yeul,slope) - implicit none - real (kind=real_kind), intent(in) :: x,y - real (kind=real_kind) , intent(in) :: yeul,slope - - if (fuzzy(ABS(slope),fuzzy_width)>0) THEN - x_cross_eul_lat = x+(yeul-y)/slope - ELSE - ! WRITE(*,*) "WARNING: slope is epsilon - ABORT" - x_cross_eul_lat = bignum - END IF - end function x_cross_eul_lat - - subroutine get_weights_exact(weights,xseg,yseg,nreconstruction) -! use cslam_analytic_mod, only: I_00, I_10, I_01, I_20, I_02, I_11 - implicit none - integer (kind=int_kind), intent(in) :: nreconstruction - real (kind=real_kind), dimension(nreconstruction), intent(out) :: weights - real (kind=real_kind), dimension(2 ), intent(in) :: xseg,yseg - ! - ! compute weights - ! - real (kind=real_kind) :: tmp,slope,b,integral,dx2,xc - integer (kind=int_kind) :: i -! weights(:) = -half*(xseg(1)*yseg(2)-xseg(2)*yseg(1)) !dummy for testing - - weights(1) = ((I_00(xseg(2),yseg(2))-I_00(xseg(1),yseg(1)))) - if (ABS(weights(1))>1.0) THEN - WRITE(*,*) "1 exact weights(jsegment)",weights(1),xseg,yseg - stop - end if - if (nreconstruction>1) then - weights(2) = ((I_10(xseg(2),yseg(2))-I_10(xseg(1),yseg(1)))) - weights(3) = ((I_01(xseg(2),yseg(2))-I_01(xseg(1),yseg(1)))) - endif - if (nreconstruction>3) then - weights(4) = ((I_20(xseg(2),yseg(2))-I_20(xseg(1),yseg(1)))) - weights(5) = ((I_02(xseg(2),yseg(2))-I_02(xseg(1),yseg(1)))) - weights(6) = ((I_11(xseg(2),yseg(2))-I_11(xseg(1),yseg(1)))) - endif - - end subroutine get_weights_exact - - - - subroutine get_weights_gauss(weights,xseg,yseg,nreconstruction,ngauss,gauss_weights,abscissae) - implicit none - integer (kind=int_kind), intent(in) :: nreconstruction,ngauss - real (kind=real_kind), dimension(nreconstruction), intent(out) :: weights - real (kind=real_kind), dimension(2 ), intent(in) :: xseg,yseg - real (kind=real_kind) :: slope - ! - ! compute weights - ! - ! - ! for Gaussian quadrature - ! - real (kind=real_kind), dimension(ngauss), intent(in) :: gauss_weights, abscissae - - ! if line-segment parallel to x or y use exact formulaes else use qudrature - ! - real (kind=real_kind) :: tmp,b,integral,dx2,xc,x,y - integer (kind=int_kind) :: i - - - - -! if (fuzzy(abs(xseg(1) -xseg(2)),fuzzy_width)==0)then - if (xseg(1).EQ.xseg(2))then - weights = 0.0D0 - else if (abs(yseg(1) -yseg(2))1) then - weights(2) = ((I_10(xseg(2),yseg(2))-I_10(xseg(1),yseg(1)))) - weights(3) = ((I_01(xseg(2),yseg(2))-I_01(xseg(1),yseg(1)))) - endif - if (nreconstruction>3) then - weights(4) = ((I_20(xseg(2),yseg(2))-I_20(xseg(1),yseg(1)))) - weights(5) = ((I_02(xseg(2),yseg(2))-I_02(xseg(1),yseg(1)))) - weights(6) = ((I_11(xseg(2),yseg(2))-I_11(xseg(1),yseg(1)))) - endif - else - - - slope = (yseg(2)-yseg(1))/(xseg(2)-xseg(1)) - b = yseg(1)-slope*xseg(1) - dx2 = 0.5D0*(xseg(2)-xseg(1)) - if (ldbgr) WRITE(*,*) "dx2 and slope in gauss weight",dx2,slope - xc = 0.5D0*(xseg(1)+xseg(2)) - integral = 0.0D0 - do i=1,ngauss - x = xc+abscissae(i)*dx2 - y = slope*x+b - integral = integral+gauss_weights(i)*F_00(x,y) - enddo - weights(1) = integral*dx2 - if (nreconstruction>1) then - integral = 0.0D0 - do i=1,ngauss - x = xc+abscissae(i)*dx2 - y = slope*x+b - integral = integral+gauss_weights(i)*F_10(x,y) - enddo - weights(2) = integral*dx2 - integral = 0.0D0 - do i=1,ngauss - x = xc+abscissae(i)*dx2 - y = slope*x+b - integral = integral+gauss_weights(i)*F_01(x,y) - enddo - weights(3) = integral*dx2 - endif - if (nreconstruction>3) then - integral = 0.0D0 - do i=1,ngauss - x = xc+abscissae(i)*dx2 - y = slope*x+b - integral = integral+gauss_weights(i)*F_20(x,y) - enddo - weights(4) = integral*dx2 - integral = 0.0D0 - do i=1,ngauss - x = xc+abscissae(i)*dx2 - y = slope*x+b - integral = integral+gauss_weights(i)*F_02(x,y) - enddo - weights(5) = integral*dx2 - integral = 0.0D0 - do i=1,ngauss - x = xc+abscissae(i)*dx2 - y = slope*x+b - integral = integral+gauss_weights(i)*F_11(x,y) - enddo - weights(6) = integral*dx2 - endif - end if - end subroutine get_weights_gauss - - real (kind=real_kind) function F_00(x_in,y_in) - implicit none - real (kind=real_kind), intent(in) :: x_in,y_in - real (kind=real_kind) :: x,y,tmp - - x = x_in - y = y_in - - F_00 =y/((1.0D0+x*x)*SQRT(1.0D0+x*x+y*y)) - end function F_00 - - real (kind=real_kind) function F_10(x_in,y_in) - implicit none - real (kind=real_kind), intent(in) :: x_in,y_in - real (kind=real_kind) :: x,y,tmp - - x = x_in - y = y_in - - F_10 =x*y/((1.0D0+x*x)*SQRT(1.0D0+x*x+y*y)) - end function F_10 - - real (kind=real_kind) function F_01(x_in,y_in) - implicit none - real (kind=real_kind), intent(in) :: x_in,y_in - real (kind=real_kind) :: x,y,tmp - - x = x_in - y = y_in - - F_01 =-1.0D0/(SQRT(1.0D0+x*x+y*y)) - end function F_01 - - real (kind=real_kind) function F_20(x_in,y_in) - implicit none - real (kind=real_kind), intent(in) :: x_in,y_in - real (kind=real_kind) :: x,y,tmp - - x = x_in - y = y_in - - F_20 =x*x*y/((1.0D0+x*x)*SQRT(1.0D0+x*x+y*y)) - end function F_20 - - real (kind=real_kind) function F_02(x_in,y_in) - implicit none - real (kind=real_kind), intent(in) :: x_in,y_in - real (kind=real_kind) :: x,y,alpha, tmp - - x = x_in - y = y_in - - alpha = ATAN(x) - tmp=y*COS(alpha) - F_02 =-y/SQRT(1.0D0+x*x+y*y)+log(tmp+sqrt(tmp*tmp+1)) - - ! - ! cos(alpha) = 1/sqrt(1+x*x) - ! - end function F_02 - - real (kind=real_kind) function F_11(x_in,y_in) - implicit none - real (kind=real_kind), intent(in) :: x_in,y_in - real (kind=real_kind) :: x,y,tmp - - x = x_in - y = y_in - - F_11 =-x/(SQRT(1.0D0+x*x+y*y)) - end function F_11 - - subroutine which_eul_cell(x,j_eul,gno) - implicit none - integer (kind=int_kind) , intent(inout) :: j_eul - real (kind=real_kind), dimension(3) , intent(in) :: x - real (kind=real_kind), dimension(-nhe:nc+2+nhe), intent(in) :: gno !phl -! real (kind=real_kind), intent(in) :: eps - - real (kind=real_kind) :: d1,d2,d3,d1p1 - logical :: lcontinue - integer :: iter - - - ! - ! this is not needed in transport code search - ! -! IF (x(1)gno(nc+2+nhe)) j_eul=nc+1+nhe -! RETURN - -! j_eul = MIN(MAX(j_eul,-nhe),nc+1+nhe) !added - - lcontinue = .TRUE. - iter = 0 - IF (ldbgr) WRITE(*,*) "from which_eul_cell",x(1),x(2),x(3) - DO WHILE (lcontinue) - iter = iter+1 - IF (x(1).GE.gno(j_eul).AND.x(1).LT.gno(j_eul+1)) THEN - lcontinue = .FALSE. - ! - ! special case when x(1) is on top of grid line - ! - IF (x(1).EQ.gno(j_eul)) THEN -! IF (ABS(x(1)-gno(j_eul))1000.OR.j_eul<-nhe.OR.j_eul>nc+2+nhe) THEN - WRITE(*,*) "search in which_eul_cell not converging!", iter,j_eul - WRITE(*,*) "input", x - WRITE(*,*) "gno", gno(nc),gno(nc+1),gno(nc+2),gno(nc+3) - STOP - END IF - END DO - END subroutine which_eul_cell - - - subroutine truncate_vertex(x,j_eul,gno) - implicit none - integer (kind=int_kind) , intent(inout) :: j_eul - real (kind=real_kind) , intent(inout) :: x - real (kind=real_kind), dimension(-nhe:nc+2+nhe), intent(in) :: gno !phl -! real (kind=real_kind), intent(in) :: eps - - logical :: lcontinue - integer :: iter - real (kind=real_kind) :: xsgn,dist,dist_new,tmp - - ! - ! this is not needed in transport code search - ! -! IF (xgno(nc+2+nhe)) j_eul=nc+1+nhe -! -! RETURN - - - lcontinue = .TRUE. - iter = 0 - dist = bignum -! j_eul = MIN(MAX(j_eul,-nhe),nc+1+nhe) !added - xsgn = INT(SIGN(1.0_dbl_kind,x-gno(j_eul))) - DO WHILE (lcontinue) - iter = iter+1 - tmp = x-gno(j_eul) - dist_new = ABS(tmp) - IF (dist_new>dist) THEN - lcontinue = .FALSE. -! ELSE IF (ABS(tmp)<1.0E-11) THEN - ELSE IF (ABS(tmp)<1.0E-9) THEN -! ELSE IF (ABS(tmp)<1.0E-4) THEN - x = gno(j_eul) - lcontinue = .FALSE. - ELSE - j_eul = j_eul+xsgn - dist = dist_new - END IF - IF (iter>10000) THEN - WRITE(*,*) "truncate vertex not converging" - STOP - END IF - END DO - END subroutine truncate_vertex - - - - -!******************************************************************************** -! -! Gauss-Legendre quadrature -! -! Tabulated values -! -!******************************************************************************** -subroutine gauss_points(n,weights,points) - implicit none - real (kind=real_kind), dimension(n), intent(out) :: weights, points - integer (kind=int_kind) , intent(in ) :: n - - select case (n) -! CASE(1) -! abscissae(1) = 0.0D0 -! weights(1) = 2.0D0 - case(2) - points(1) = -sqrt(1.0D0/3.0D0) - points(2) = sqrt(1.0D0/3.0D0) - weights(1) = 1.0D0 - weights(2) = 1.0D0 - case(3) - points(1) = -0.774596669241483377035853079956D0 - points(2) = 0.0D0 - points(3) = 0.774596669241483377035853079956D0 - weights(1) = 0.555555555555555555555555555556D0 - weights(2) = 0.888888888888888888888888888889D0 - weights(3) = 0.555555555555555555555555555556D0 - case(4) - points(1) = -0.861136311594052575223946488893D0 - points(2) = -0.339981043584856264802665659103D0 - points(3) = 0.339981043584856264802665659103D0 - points(4) = 0.861136311594052575223946488893D0 - weights(1) = 0.347854845137453857373063949222D0 - weights(2) = 0.652145154862546142626936050778D0 - weights(3) = 0.652145154862546142626936050778D0 - weights(4) = 0.347854845137453857373063949222D0 - case(5) - points(1) = -(1.0D0/3.0D0)*sqrt(5.0D0+2.0D0*sqrt(10.0D0/7.0D0)) - points(2) = -(1.0D0/3.0D0)*sqrt(5.0D0-2.0D0*sqrt(10.0D0/7.0D0)) - points(3) = 0.0D0 - points(4) = (1.0D0/3.0D0)*sqrt(5.0D0-2.0D0*sqrt(10.0D0/7.0D0)) - points(5) = (1.0D0/3.0D0)*sqrt(5.0D0+2.0D0*sqrt(10.0D0/7.0D0)) - weights(1) = (322.0D0-13.0D0*sqrt(70.0D0))/900.0D0 - weights(2) = (322.0D0+13.0D0*sqrt(70.0D0))/900.0D0 - weights(3) = 128.0D0/225.0D0 - weights(4) = (322.0D0+13.0D0*sqrt(70.0D0))/900.0D0 - weights(5) = (322.0D0-13.0D0*sqrt(70.0D0))/900.0D0 - case default - write(*,*) 'n out of range in glwp of module gll. n=',n - write(*,*) '0 0.0D0) THEN - signum = 1.0D0 - ELSEIF (x < 0.0D0) THEN - signum = -1.0D0 - ELSE - signum = 0.0D0 - ENDIF - end function - -!------------------------------------------------------------------------------ -! FUNCTION SIGNUM_FUZZY -! -! Description: -! Gives the sign of the given real number, returning zero if x is within -! a small amount from zero. -!------------------------------------------------------------------------------ - function signum_fuzzy(x) - implicit none - - real (kind=real_kind) :: signum_fuzzy - real (kind=real_kind) :: x - - IF (x > fuzzy_width) THEN - signum_fuzzy = 1.0D0 - ELSEIF (x < fuzzy_width) THEN - signum_fuzzy = -1.0D0 - ELSE - signum_fuzzy = 0.0D0 - ENDIF - end function - - function fuzzy(x,epsilon) - implicit none - - integer (kind=int_kind) :: fuzzy - real (kind=real_kind), intent(in) :: epsilon - real (kind=real_kind) :: x - - IF (ABS(x)epsilon) THEN - fuzzy = 1 - ELSE !IF (x < fuzzy_width) THEN - fuzzy = -1 - ENDIF - end function - -! -! see, e.g., http://local.wasp.uwa.edu.au/~pbourke/geometry/lineline2d/ -! -subroutine check_lines_cross(x1,x2,x3,x4,y1,y2,y3,y4,lcross) - implicit none - real (kind=real_kind), INTENT(IN) :: x1,x2,x3,x4,y1,y2,y3,y4 - LOGICAL, INTENT(OUT) :: lcross - ! - ! local workspace - ! - real (kind=real_kind) :: cp,tx,ty - - cp = (y4-y3)*(x2-x1)-(x4-x3)*(y2-y1) - IF (ABS(cp)-tiny.AND.tx<1.0D0+tiny.AND.& - ty>-tiny.AND.ty<1.0D0+tiny) THEN - lcross = .TRUE. - ELSE - lcross = .FALSE. -! WRITE(*,*) "not parallel but not crossing,",tx,ty - ENDIF - ENDIF -end subroutine check_lines_cross - - - REAL (KIND=dbl_kind) FUNCTION I_00(x_in,y_in) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in - REAL (KIND=dbl_kind) :: x,y - - x = x_in/aa - y = y_in/aa -! x = x_in -! y = y_in - I_00 = ATAN(x*y/SQRT(one+x*x+y*y)) - END FUNCTION I_00 - - REAL (KIND=dbl_kind) FUNCTION I_10(x_in,y_in) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in - REAL (KIND=dbl_kind) :: x,y,tmp - - x = x_in/aa - y = y_in/aa - tmp = ATAN(x) - I_10 = -ASINH(y*COS(tmp)) - ! - ! = -arcsinh(y/sqrt(1+x^2)) - ! - END FUNCTION I_10 - - REAL (KIND=dbl_kind) FUNCTION I_10_ab(alpha,beta) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta - I_10_ab = -ASINH(COS(alpha) * TAN(beta)) - END FUNCTION I_10_AB - - REAL (KIND=dbl_kind) FUNCTION I_01(x_in,y_in) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in - REAL (KIND=dbl_kind) :: x,y!,beta - - x = x_in/aa - y = y_in/aa -! beta = ATAN(y) -! I_01 = -ASINH(x*COS(beta)) - I_01 = -ASINH(x/SQRT(1+y*y)) - END FUNCTION I_01 - - REAL (KIND=dbl_kind) FUNCTION I_01_ab(alpha,beta) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta - I_01_ab = -ASINH(COS(beta) * TAN(alpha)) - END FUNCTION I_01_AB - - REAL (KIND=dbl_kind) FUNCTION I_20(x_in,y_in) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in - REAL (KIND=dbl_kind) :: x,y, tmp!,alpha,beta - - x = x_in/aa - y = y_in/aa -! alpha = aa*ATAN(x) -! beta = aa*ATAN(y) - - tmp = one+y*y - -! I_20 = y*ASINH(COS(beta)*x)+ACOS(SIN(alpha)*SIN(beta)) - I_20 = y*ASINH(x/SQRT(tmp))+ACOS(x*y/(SQRT((one+x*x)*tmp))) - END FUNCTION I_20 - - REAL (KIND=dbl_kind) FUNCTION I_20_ab(alpha,beta) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta - - I_20_ab = TAN(beta)*ASINH(COS(beta)*TAN(alpha))+ACOS(SIN(alpha)*SIN(beta)) - END FUNCTION I_20_AB - - REAL (KIND=dbl_kind) FUNCTION I_02(x_in,y_in) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in - REAL (KIND=dbl_kind) :: x,y, tmp!,alpha,beta - - x = x_in/aa - y = y_in/aa -! alpha = aa*ATAN(x) -! beta = aa*ATAN(y) - - tmp=one+x*x - - I_02 = x*ASINH(y/SQRT(tmp))+ACOS(x*y/SQRT(tmp*(1+y*y))) - END FUNCTION I_02 - - REAL (KIND=dbl_kind) FUNCTION I_02_ab(alpha,beta) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta - - I_02_ab = TAN(alpha)*ASINH(TAN(beta)*COS(alpha))+ACOS(SIN(alpha)*SIN(beta)) - END FUNCTION I_02_AB - - - REAL (KIND=dbl_kind) FUNCTION I_11(x_in,y_in) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in - REAL (KIND=dbl_kind) :: x,y - - x = x_in/aa - y = y_in/aa - - I_11 = -SQRT(1+x*x+y*y) - END FUNCTION I_11 - - REAL (KIND=dbl_kind) FUNCTION I_11_ab(alpha,beta) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta - - I_11_ab = -SQRT(one+TAN(alpha)**2+TAN(beta)**2) - END FUNCTION I_11_AB -!------------------------------------------------------------------------------ -! FUNCTION ASINH -! -! Description: -! Hyperbolic arcsin function -!------------------------------------------------------------------------------ - FUNCTION ASINH(x) - IMPLICIT NONE - - REAL (KIND=dbl_kind) :: ASINH - REAL (KIND=dbl_kind) :: x - - ASINH = LOG(x + SQRT(x * x + one)) - END FUNCTION - - - !******************************************************************************** - ! - ! Gauss-Legendre quadrature - ! - ! Tabulated values - ! - !******************************************************************************** - SUBROUTINE glwp(n,weights,abscissae) - IMPLICIT NONE - REAL (KIND=dbl_kind), DIMENSION(n), INTENT(OUT) :: weights, abscissae - INTEGER (KIND=int_kind) , INTENT(IN ) :: n - - SELECT CASE (n) - CASE(1) - abscissae(1) = 0.0 - weights(1) = 2.0 - CASE(2) - abscissae(1) = -SQRT(1.0/3.0) - abscissae(2) = SQRT(1.0/3.0) - weights(1) = 1.0 - weights(2) = 1.0 - CASE(3) - abscissae(1) = -0.774596669241483377035853079956_dbl_kind - abscissae(2) = 0.0 - abscissae(3) = 0.774596669241483377035853079956_dbl_kind - weights(1) = 0.555555555555555555555555555556_dbl_kind - weights(2) = 0.888888888888888888888888888889_dbl_kind - weights(3) = 0.555555555555555555555555555556_dbl_kind - CASE(4) - abscissae(1) = -0.861136311594052575223946488893_dbl_kind - abscissae(2) = -0.339981043584856264802665659103_dbl_kind - abscissae(3) = 0.339981043584856264802665659103_dbl_kind - abscissae(4) = 0.861136311594052575223946488893_dbl_kind - weights(1) = 0.347854845137453857373063949222_dbl_kind - weights(2) = 0.652145154862546142626936050778_dbl_kind - weights(3) = 0.652145154862546142626936050778_dbl_kind - weights(4) = 0.347854845137453857373063949222_dbl_kind - CASE(5) - abscissae(1) = -(1.0/3.0)*SQRT(5.0+2.0*SQRT(10.0/7.0)) - abscissae(2) = -(1.0/3.0)*SQRT(5.0-2.0*SQRT(10.0/7.0)) - abscissae(3) = 0.0 - abscissae(4) = (1.0/3.0)*SQRT(5.0-2.0*SQRT(10.0/7.0)) - abscissae(5) = (1.0/3.0)*SQRT(5.0+2.0*SQRT(10.0/7.0)) - weights(1) = (322.0_dbl_kind-13.0_dbl_kind*SQRT(70.0_dbl_kind))/900.0_dbl_kind - weights(2) = (322.0_dbl_kind+13.0_dbl_kind*SQRT(70.0_dbl_kind))/900.0_dbl_kind - weights(3) = 128.0_dbl_kind/225.0_dbl_kind - weights(4) = (322.0_dbl_kind+13.0_dbl_kind*SQRT(70.0_dbl_kind))/900.0_dbl_kind - weights(5) = (322.0_dbl_kind-13.0_dbl_kind*SQRT(70.0_dbl_kind))/900.0_dbl_kind - CASE DEFAULT - WRITE(*,*) 'n out of range in glwp of module gll. n=',n - WRITE(*,*) '0 shr_kind_r8 - implicit none -! - integer, parameter :: ntile = 33 ! number of tiles in USGS GTOPO30 dataset - integer, parameter :: im = 43200 ! total grids in x direction of 30-sec global dataset - integer, parameter :: jm = 21600 ! total grids in y direction of 30-sec global dataset - real(r8), parameter :: dx = 1.0/120.0 ! space interval for 30-sec data (in degree) - - character (len=7) :: nmtile(ntile) ! name of each tile - integer :: ncols,nrows ! number of columns and rows for 30-sec tile - integer :: nodata ! integer for ocean point - real(r8):: ulxmap ! longitude at the center of the upper-left corner cell in the 30-sec tile - real(r8):: ulymap ! latitude at the center of the upper-left corner cell in the 30-sec tile - real(r8):: lon_start ! longitude at the center of grid (1,1) in the 30-sec netCDF global data - real(r8):: lat_start ! latitude at the center of grid (1,1) in the 30-sec netCDF global data - real(r8):: lonsw ! longitude at the center of southwest corner cell in the 30-sec tile - real(r8):: latsw ! latitude at the center of southwest corner cell in the 30-sec tile - integer :: i1,j1 ! the (i,j) point of the southwest corner of the 30-sec tile in the global grid - - integer*2, allocatable, dimension(:,:) :: terr ! global 30-sec terrain data - integer*1, allocatable, dimension(:,:) :: land_fraction ! global 30-sec land fraction - - integer :: alloc_error,dealloc_error - integer :: i,j,n ! index - integer*2, allocatable, dimension(:,:) :: iterr ! terrain data for 30-sec tile - integer*2, allocatable, dimension(:,:) :: terr_tile ! terrain data for 30-sec tile - integer*1, allocatable, dimension(:,:) :: land_fraction_tile -! - lat_start=-90.0 + 0.5 * dx - lon_start=0.5*dx - ! - ! Initialize each tile name - ! - nmtile(1) = 'W180N90' - nmtile(2) = 'W140N90' - nmtile(3) = 'W100N90' - nmtile(4) = 'W060N90' - nmtile(5) = 'W020N90' - nmtile(6) = 'E020N90' - nmtile(7) = 'E060N90' - nmtile(8) = 'E100N90' - nmtile(9) = 'E140N90' - - nmtile(10) = 'W180N40' - nmtile(11) = 'W140N40' - nmtile(12) = 'W100N40' - nmtile(13) = 'W060N40' - nmtile(14) = 'W020N40' - nmtile(15) = 'E020N40' - nmtile(16) = 'E060N40' - nmtile(17) = 'E100N40' - nmtile(18) = 'E140N40' - - nmtile(19) = 'W180S10' - nmtile(20) = 'W140S10' - nmtile(21) = 'W100S10' - nmtile(22) = 'W060S10' - nmtile(23) = 'W020S10' - nmtile(24) = 'E020S10' - nmtile(25) = 'E060S10' - nmtile(26) = 'E100S10' - nmtile(27) = 'E140S10' - - nmtile(28) = 'W180S60' - nmtile(29) = 'W120S60' - nmtile(30) = 'W060S60' - nmtile(31) = 'W000S60' - nmtile(32) = 'E060S60' - nmtile(33) = 'E120S60' - - - allocate ( land_fraction(im,jm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for land_fraction' - stop - end if - - allocate ( terr(im,jm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for terr' - stop - end if - - do j = 1, jm - do i = 1, im - terr(i,j) = -999999.0 - land_fraction(i,j) = -99.0 - end do - end do - - do n = 1,ntile -! -! Read header for each tile -! - call rdheader(nmtile(n),nrows,ncols,nodata,ulxmap,ulymap) - -! -! Allocate space for array iterr -! - allocate ( iterr(ncols,nrows),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for iterr' - stop - end if -! -! Read terr data for each tile -! - call rdterr(nmtile(n),nrows,ncols,iterr) -! -! Allocate space for arrays terr_tile and psea10m -! - allocate ( terr_tile(ncols,nrows),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for terr_tile' - stop - end if - allocate ( land_fraction_tile(ncols,nrows),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for land_fraction_tile' - stop - end if -! -! Expand Caspian Sea for tiles 6 and 15 -! - if(nmtile(n).eq.'E020N90')call expand_sea(ncols,nrows,iterr,nodata,3600,5300) - if(nmtile(n).eq.'E020N90')call expand_sea(ncols,nrows,iterr,nodata,4088,5874) - if(nmtile(n).eq.'E020N40')call expand_sea(ncols,nrows,iterr,nodata,3600,1) - print *, "min and maxiterr: ", minval(iterr), maxval(iterr) -! -! area average of 30-sec tile to 30-sec tile -! - call avg(ncols,nrows,iterr,nodata,ulymap,dx,terr_tile,land_fraction_tile) - -! -! Print some info on the fields - print *, "min and max elevations: ", minval(terr_tile), maxval(terr_tile) - print *, "min and max land_fraction: ", minval(land_fraction_tile), maxval(land_fraction_tile) -! -! fit the 30-sec tile into global 30-sec dataset -! - - latsw= ulymap - (nrows-1) * dx - lonsw = ulxmap - if( lonsw < 0.0 ) lonsw=360.0+lonsw - i1 = nint( (lonsw - lon_start) / dx )+1 - if( i1 <= 0 ) i1 = i1 + im - if( i1 > im ) i1 = i1 - im - j1 = nint( (latsw- lat_start) / dx )+1 - -! print*,'ulymap,ulxmap,latsw10,lonsw = ',ulymap,ulxmap,latsw10,lonsw -! print*,'i1,j1 = ', i1,j1 - - call fitin(ncols,nrows,terr_tile,land_fraction_tile,i1,j1,im,jm,terr,land_fraction) -! -! Deallocate working space for arrays iterr, terr_tile and psea10m -! - deallocate ( iterr,terr_tile,land_fraction_tile,stat=dealloc_error ) - if( dealloc_error /= 0 ) then - print*,'Unexpected deallocation error for arrays iterr,terr_tile' - stop - end if - - end do - WRITE(*,*) 'done reading in USGS data' -! -! Print some info on the fields - print *, "min and max elevations: ", minval(terr), maxval(terr) - print *, "min and max land frac: ", minval(land_fraction), maxval(land_fraction) -! -! Write 30-sec terrain dataset, and land_fraction to NetCDF file -! -! call wrtncdf(im,jm,terr,land_fraction,dx) - call wrtncdf(im,jm,terr,land_fraction,dx,100) - end program convterr - - subroutine rdheader(nmtile,nrows,ncols,nodata,ulxmap,ulymap) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine read the header of USGA Global30 sec TOPO data set. -! - implicit none -! -! Dummy arguments -! - character (len=7), intent(in) :: nmtile ! name of the tile - integer, intent(out) :: nrows ! number of rows - integer, intent(out) :: ncols ! number of column - integer, intent(out) :: nodata ! integer for ocean data point - real(r8), intent(out) :: ulxmap - real(r8), intent(out) :: ulymap -! -! Local variables -! - character (len=11) :: flheader ! file name of the header - character (len=13) :: chars ! dummy character - - flheader=nmtile//'.HDR' - - print*,'flheader = ', flheader -! -! Open GTOPO30 Header File -! - open(unit=10,file=flheader,status='old',form='formatted') -! -! Read GTOPO30 Header file -! - read (10, *) - read (10, *) - read (10, *) chars,nrows - print*,chars,' = ',nrows - read (10, *) chars,ncols - print*,chars,' = ',ncols - read (10, *) - read (10, *) - read (10, *) - read (10, *) - read (10, *) - read (10, *) chars,nodata - print*,chars,' = ',nodata - read (10, *) chars,ulxmap - print*,chars,' = ',ulxmap - read (10, *) chars,ulymap - print*,chars,' = ',ulymap - close(10) - - end subroutine rdheader - - subroutine rdterr(nmtile,nrows,ncols,iterr) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine read the USGS Global 30-sec terrain data for each tile. -! - implicit none -! -! Dummy arguments -! - character (len=7), intent(in) :: nmtile ! name of the tile - integer, intent(in) :: nrows ! number of rows - integer, intent(in) :: ncols ! number of column - integer*2, dimension(ncols,nrows), intent(out) :: iterr ! terrain data -! -! Local variables -! - character (len=11) :: flterr ! file name for each terr dataset - integer :: io_error ! I/O status - integer :: i,j ! Index - integer :: length ! record length - - flterr=nmtile//'.DEM' - -! print*,'flterr = ', flterr -! print*,'nrows,ncols = ',nrows,ncols -! -! Open GTOPO30 Terrain dataset File -! - - length = 2 * ncols * nrows - io_error=0 - open(unit=11,file=flterr,access='direct',recl=length,iostat=io_error) - if( io_error /= 0 ) then - print*,'Open file error in subroutine rdterr' - print*,'iostat = ', io_error - stop - end if -! -! Read GTOPO30 Terrain data file -! - read (11,rec=1,iostat=io_error) ((iterr(i,j),i=1,ncols),j=1,nrows) -! - if( io_error /= 0 ) then - print*,'Data file error in subroutine rdterr' - print*,'iostat = ', io_error - stop - end if -! -! Print some info on the fields - print *, "min and max elevations: ", minval(iterr), maxval(iterr) -! -! Correct missing data in source files -! -! Missing data near dateline - - if( nmtile == 'W180S60' ) then - do j = 1, nrows - iterr(1,j) = iterr(2,j) - end do - else if (nmtile == 'E120S60') then - do j = 1, nrows - iterr(ncols-1,j) = iterr(ncols-2,j) - iterr(ncols,j) = iterr(ncols-2,j) - end do - end if -! -! Missing data at the southermost row near South pole -! - if( nmtile == 'E060S60' .or. nmtile == 'E120S60' .or. nmtile == 'W000S60' .or. & - nmtile == 'W060S60' .or. nmtile == 'W120S60' .or. nmtile == 'W180S60' ) then - do i=1,ncols - iterr(i,nrows) = iterr(i,nrows-1) - end do - end if -! -! print*,'iterr(1,1),iterr(ncols,nrows) = ', & -! iterr(1,1),iterr(ncols,nrows) - - close (11) - end subroutine rdterr - - subroutine avg(ncols,nrows,iterr,nodata,ulymap,dx,terr_tile,land_fraction_tile) - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none -! -! Dummy arguments -! - integer, intent(in) :: ncols ! number of column for 30-sec tile - integer, intent(in) :: nrows ! number of rows for 30-sec tile - integer*2, dimension(ncols,nrows), intent(inout) :: iterr ! terrain data for 30-sec tile - integer, intent(in) :: nodata ! integer for ocean data point - real(r8),intent(in) :: ulymap ! latitude at the center of the upper-left corner cell in the 30-sec tile - real(r8),intent(in) :: dx ! spacing interval for 30-sec data (in degree) - integer*2, dimension(ncols,nrows), intent(out) :: terr_tile ! terrain data for 30-sec tile - integer*1, dimension(ncols,nrows), intent(out) :: land_fraction_tile -! -! Local variables -! - real(r8) :: lats,latn ! latitudes (in rad) for ths south and north edges of each 30-sec cell - real(r8) :: wt ! area weighting of each 30-sec cell - real(r8) :: wt_tot ! total weighting of each 30-sec cell - real(r8) :: sumterr ! summation of terrain height of each 30-sec cell - real(r8) :: sumsea ! summation of sea coverage of each 30-sec cell - real(r8) :: pi ! pi=3.1415 - real(r8) :: latul ! latitude of the upper-left coner of 30-sec tile - integer :: n1,itmp,i1,i2,j1,j2 ! temporary working spaces - integer :: i,j,ii,jj ! index - logical, dimension(ncols,nrows) :: oflag - - pi = 4.0 * atan(1.0) -! - n1 = ncols / ncols - print*,'ncols,ncols,n1 = ',ncols,ncols,n1 - - itmp = nint( ulymap + 0.5 * dx ) - latul = itmp - print*,'ulymap,latul = ', ulymap,latul - oflag = .false. - - do j = 1, nrows - j1 = j - j2 = j - do i = 1, ncols - i1 = i - i2 = i - terr_tile(i,j) = 0 - land_fraction_tile(i,j) = 1 - if ( iterr(i,j) == nodata ) then - land_fraction_tile(i,j) = 0 - else - if ( iterr(i,j) .lt.nodata ) then - ! this can only happen in the expand_sea routine - land_fraction_tile(i,j) = 0 - iterr(i,j) = iterr(i,j) - nodata - nodata - endif - terr_tile(i,j) = iterr(i,j) - end if - end do - end do - - end subroutine avg - - subroutine expand_sea(ncols,nrows,iterr,nodata,startx,starty) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine reduces the resolution of the terrain data from 30-sec to 30-sec and -! compute the percentage of ocean cover (psea10m) -! - implicit none -! -! Dummy arguments -! - integer, intent(in) :: ncols ! number of column for 30-sec tile - integer, intent(in) :: nrows ! number of rows for 30-sec tile - integer*2, dimension(ncols,nrows), intent(inout) :: iterr ! terrain data for 30-sec tile - integer, intent(in) :: nodata ! integer for ocean data point - integer, intent(in) :: startx, starty ! where to begin the sea -! -! Local variables -! - real(r8):: maxh - integer :: i,j,per,ii,jj ! index - logical, dimension(0:ncols+1,0:nrows+1) :: flag ! terrain data for 30-sec tile - logical :: found - - flag = .false. - - maxh = iterr(startx,starty) - - iterr(startx,starty) = iterr(startx,starty) + nodata + nodata - flag(startx-1:startx+1,starty-1:starty+1) = .true. - - per = 0 - print *, 'expanding sea at ',maxh,' m ' - -2112 per = per + 1 - found = .false. - do j = starty - per, starty + per, per*2 - do i = startx - per, startx + per - if(i.ge.1.and.i.le.ncols.and.j.ge.1.and.j.le.nrows)then - if( iterr(i,j).eq.maxh .and. flag(i,j) ) then - iterr(i,j) = iterr(i,j) + nodata + nodata - flag(i-1:i+1,j-1:j+1) = .true. - found = .true. - endif - endif - end do - end do - - do i = startx - per, startx + per, per*2 - do j = starty - per + 1, starty + per - 1 - if(i.ge.1.and.i.le.ncols.and.j.ge.1.and.j.le.nrows)then - if( iterr(i,j).eq.maxh .and. flag(i,j) ) then - iterr(i,j) = iterr(i,j) + nodata + nodata - flag(i-1:i+1,j-1:j+1) = .true. - found = .true. - endif - endif - end do - end do - if (found)goto 2112 - print *, 'done with expand_sea' - return - - end subroutine expand_sea - - subroutine fitin(ncols,nrows,terr_tile,land_fraction_tile,i1,j1,im,jm,terr,land_fraction) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine put 30-sec tile into the global dataset -! - implicit none -! -! Dummy arguments -! - integer, intent(in) :: ncols ! number of columns for 30-sec tile - integer, intent(in) :: nrows ! number of rows for 30-sec tile - integer*2, dimension(ncols,nrows), intent(in) :: terr_tile ! terrain data for 30-sec tile - integer*1, dimension(ncols,nrows), intent(in) :: land_fraction_tile - integer, intent(in) :: i1,j1 ! the (i,j) point of the southwest corner of the 30-sec tile - ! in the global grid - integer, intent(in) :: im,jm ! the dimensions of the 30-sec global dataset - integer*2,dimension(im,jm), intent(out) :: terr ! global 30-sec terrain data - integer*1,dimension(im,jm), intent(out) :: land_fraction ! global 30-sec land fraction -! -! Local variables -! - integer :: i,j,ii,jj ! index - - do j = 1, nrows - jj = j1 + (nrows - j) - do i = 1, ncols - ii = i1 + (i-1) - - if( i == 1 .and. j == 1 ) & - print*,'i,j,ii,jj = ',i,j,ii,jj - if( i == ncols .and. j == nrows ) & - print*,'i,j,ii,jj = ',i,j,ii,jj - - if( ii > im ) ii = ii - im - terr(ii,jj) = terr_tile(i,j) - land_fraction(ii,jj) = land_fraction_tile(i,j) - end do - end do - end subroutine fitin - - subroutine wrtncdf(im,jm,terr,land_fraction,dx) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine save 30-sec terrain data, land fraction to NetCDF file -! - implicit none - -# include - -! -! Dummy arguments -! - integer, intent(in) :: im,jm ! the dimensions of the 30-sec global dataset - integer*2,dimension(im,jm), intent(in) :: terr ! global 30-sec terrain data - integer*1,dimension(im,jm), intent(in) :: land_fraction !global 30-sec land fraction - real(r8), intent(in) :: dx -! -! Local variables -! - real(r8),dimension(im) :: lonar ! longitude array - real(r8),dimension(im) :: latar ! latitude array - character (len=32) :: fout ! NetCDF output file - integer :: foutid ! Output file id - integer :: lonid, lonvid - integer :: latid, latvid - integer :: htopoid - integer :: landfid - integer, dimension(2) :: htopodim,landfdim - integer :: status ! return value for error control of netcdf routin - integer :: i,j - character (len=8) :: datestring - - integer*2,dimension(im,jm) :: h ! global 30-sec terrain data - integer*1,dimension(im,jm) :: lnd - - -! -! Fill lat and lon arrays -! - do i = 1,im - lonar(i)= dx * (i-0.5) - enddo - do j = 1,jm - latar(j)= -90.0 + dx * (j-0.5) - enddo - - do j=1,jm - do i=1,im - h(i,j) = terr(i,j) - lnd(i,j) = land_fraction(i,j) - end do - end do - - fout='usgs-rawdata.nc' -! -! Create NetCDF file for output -! - print *,"Create NetCDF file for output" - status = nf_create (fout, NF_64BIT_OFFSET , foutid) - if (status .ne. NF_NOERR) call handle_err(status) -! -! Create dimensions for output -! - print *,"Create dimensions for output" - status = nf_def_dim (foutid, 'lon', im, lonid) - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_def_dim (foutid, 'lat', jm, latid) - if (status .ne. NF_NOERR) call handle_err(status) -! -! Create variable for output -! - print *,"Create variable for output" - htopodim(1)=lonid - htopodim(2)=latid - status = nf_def_var (foutid,'htopo', NF_INT, 2, htopodim, htopoid) - if (status .ne. NF_NOERR) call handle_err(status) -! - landfdim(1)=lonid - landfdim(2)=latid - status = nf_def_var (foutid,'landfract', NF_INT, 2, landfdim, landfid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'lat', NF_DOUBLE, 1, latid, latvid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'lon', NF_DOUBLE, 1, lonid, lonvid) - if (status .ne. NF_NOERR) call handle_err(status) - -! -! Create attributes for output variables -! - status = nf_put_att_text (foutid,htopoid,'long_name', 41, '30-sec elevation from USGS 30-sec dataset') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,htopoid,'units', 5, 'meter') - if (status .ne. NF_NOERR) call handle_err(status) -! - status = nf_put_att_text (foutid,landfid,'long_name', 23, '30-second land fraction') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,landfid,'units', 14, 'fraction (0-1)') - if (status .ne. NF_NOERR) call handle_err(status) -! - status = nf_put_att_text (foutid,latvid,'long_name', 8, 'latitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,latvid,'units', 13, 'degrees_north') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,latvid,'units', 21, 'cell center locations') - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,lonvid,'long_name', 9, 'longitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,lonvid,'units', 12, 'degrees_east') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,lonvid,'units' , 21, 'cell center locations') - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,NF_GLOBAL,'source', 27, 'USGS 30-sec dataset GTOPO30') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,NF_GLOBAL,'title', 24, '30-second USGS topo data') - if (status .ne. NF_NOERR) call handle_err(status) - call DATE_AND_TIME(DATE=datestring) - status = nf_put_att_text (foutid,NF_GLOBAL,'history',25, 'Written on date: ' // datestring ) - if (status .ne. NF_NOERR) call handle_err(status) - -! -! End define mode for output file -! - status = nf_enddef (foutid) - if (status .ne. NF_NOERR) call handle_err(status) -! -! Write variable for output -! - print*,"writing terrain data" - status = nf_put_var_int2 (foutid, htopoid, h) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing terrain data" -! - status = nf_put_var_int1 (foutid, landfid, lnd) - if (status .ne. NF_NOERR) call handle_err(status) -! - print*,"writing lat data" - status = nf_put_var_double (foutid, latvid, latar) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing lat data" - - print*,"writing lon data" - status = nf_put_var_double (foutid, lonvid, lonar) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing lon data" -! -! Close output file -! - print *,"close file" - status = nf_close (foutid) - if (status .ne. NF_NOERR) call handle_err(status) - - end subroutine wrtncdf - - - ! - ! same as wrtncdf but the output is coarsened - ! - subroutine wrtncdf_coarse(im,jm,terr,land_fraction,dx,ic) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine save 30-sec terrain data, land fraction to NetCDF file -! - implicit none - -# include - -! -! Dummy arguments -! - integer, intent(in) :: im,jm ! the dimensions of the 30-sec global dataset - integer, intent(in) :: ic ! coarsening factor - integer*2,dimension(im,jm), intent(in) :: terr ! global 30-sec terrain data - integer*1,dimension(im,jm), intent(in) :: land_fraction !global 30-sec land fraction - real(r8), intent(in) :: dx -! -! Local variables -! - real(r8),dimension(im/ic) :: lonar ! longitude array - real(r8),dimension(im/ic) :: latar ! latitude array - character (len=32) :: fout ! NetCDF output file - integer :: foutid ! Output file id - integer :: lonid, lonvid - integer :: latid, latvid - integer :: htopoid - integer :: landfid - integer, dimension(2) :: htopodim,landfdim - integer :: status ! return value for error control of netcdf routin - integer :: i,j - character (len=8) :: datestring - - integer*2,dimension(im/ic,jm/ic) :: h ! global 30-sec terrain data - integer*1,dimension(im/ic,jm/ic) :: lnd - - -! -! Fill lat and lon arrays -! - do i = 1,im/ic - lonar(i)= real(ic)*dx * (i-0.5) - enddo - do j = 1,jm/ic - latar(j)= -90.0 + real(ic)*dx * (j-0.5) - enddo - - do j=1,jm/ic - do i=1,im/ic - h(i,j) = terr(i*ic,j*ic) - lnd(i,j) = land_fraction(i*ic,j*ic) - end do - end do - - fout='usgs-lowres.nc' -! -! Create NetCDF file for output -! - print *,"Create NetCDF file for output" - status = nf_create (fout, NF_64BIT_OFFSET , foutid) - if (status .ne. NF_NOERR) call handle_err(status) -! -! Create dimensions for output -! - print *,"Create dimensions for output" - status = nf_def_dim (foutid, 'lon', im/ic, lonid) - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_def_dim (foutid, 'lat', jm/ic, latid) - if (status .ne. NF_NOERR) call handle_err(status) -! -! Create variable for output -! - print *,"Create variable for output" - htopodim(1)=lonid - htopodim(2)=latid - status = nf_def_var (foutid,'htopo', NF_INT, 2, htopodim, htopoid) - if (status .ne. NF_NOERR) call handle_err(status) -! - landfdim(1)=lonid - landfdim(2)=latid - status = nf_def_var (foutid,'landfract', NF_INT, 2, landfdim, landfid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'lat', NF_DOUBLE, 1, latid, latvid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'lon', NF_DOUBLE, 1, lonid, lonvid) - if (status .ne. NF_NOERR) call handle_err(status) - -! -! Create attributes for output variables -! - status = nf_put_att_text (foutid,htopoid,'long_name', 41, '30-sec elevation from USGS 30-sec dataset') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,htopoid,'units', 5, 'meter') - if (status .ne. NF_NOERR) call handle_err(status) -! - status = nf_put_att_text (foutid,landfid,'long_name', 23, '30-second land fraction') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,landfid,'units', 14, 'fraction (0-1)') - if (status .ne. NF_NOERR) call handle_err(status) -! - status = nf_put_att_text (foutid,latvid,'long_name', 8, 'latitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,latvid,'units', 13, 'degrees_north') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,latvid,'units', 21, 'cell center locations') - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,lonvid,'long_name', 9, 'longitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,lonvid,'units', 12, 'degrees_east') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,lonvid,'units' , 21, 'cell center locations') - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,NF_GLOBAL,'source', 27, 'USGS 30-sec dataset GTOPO30') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,NF_GLOBAL,'title', 24, '30-second USGS topo data') - if (status .ne. NF_NOERR) call handle_err(status) - call DATE_AND_TIME(DATE=datestring) - status = nf_put_att_text (foutid,NF_GLOBAL,'history',25, 'Written on date: ' // datestring ) - if (status .ne. NF_NOERR) call handle_err(status) - -! -! End define mode for output file -! - status = nf_enddef (foutid) - if (status .ne. NF_NOERR) call handle_err(status) -! -! Write variable for output -! - print*,"writing terrain data" - status = nf_put_var_int2 (foutid, htopoid, h) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing terrain data" -! - status = nf_put_var_int1 (foutid, landfid, lnd) - if (status .ne. NF_NOERR) call handle_err(status) -! - print*,"writing lat data" - status = nf_put_var_double (foutid, latvid, latar) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing lat data" - - print*,"writing lon data" - status = nf_put_var_double (foutid, lonvid, lonar) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing lon data" -! -! Close output file -! - print *,"close file" - status = nf_close (foutid) - if (status .ne. NF_NOERR) call handle_err(status) - - end subroutine wrtncdf_coarse -!************************************************************************ -!!handle_err -!************************************************************************ -! -!!ROUTINE: handle_err -!!DESCRIPTION: error handler -!-------------------------------------------------------------------------- - - subroutine handle_err(status) - - implicit none - -# include - - integer status - - if (status .ne. nf_noerr) then - print *, nf_strerror(status) - stop 'Stopped' - endif - - end subroutine handle_err - - - diff --git a/tools/topo_tool/gen_netCDF_from_USGS/shr_kind_mod.F90 b/tools/topo_tool/gen_netCDF_from_USGS/shr_kind_mod.F90 deleted file mode 100644 index fc1ed8e94a..0000000000 --- a/tools/topo_tool/gen_netCDF_from_USGS/shr_kind_mod.F90 +++ /dev/null @@ -1,20 +0,0 @@ -!=============================================================================== -! CVS: $Id$ -! CVS: $Source$ -! CVS: $Name$ -!=============================================================================== - -MODULE shr_kind_mod - - !---------------------------------------------------------------------------- - ! precision/kind constants add data public - !---------------------------------------------------------------------------- - public - integer,parameter :: SHR_KIND_R8 = selected_real_kind(12) ! 8 byte real - integer,parameter :: SHR_KIND_R4 = selected_real_kind( 6) ! 4 byte real - integer,parameter :: SHR_KIND_RN = kind(1.0) ! native real - integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer - integer,parameter :: SHR_KIND_I4 = selected_int_kind ( 6) ! 4 byte integer - integer,parameter :: SHR_KIND_IN = kind(1) ! native integer - -END MODULE shr_kind_mod