diff --git a/.github/scripts/branch_pr_issue_closer.py b/.github/scripts/branch_pr_issue_closer.py index 429fd498e6..1065ded147 100755 --- a/.github/scripts/branch_pr_issue_closer.py +++ b/.github/scripts/branch_pr_issue_closer.py @@ -21,8 +21,6 @@ import re import sys -import subprocess -import shlex import argparse from github import Github @@ -31,42 +29,6 @@ #HELPER FUNCTIONS ################# -#+++++++++++++++++++++++++++++++++++++++++ -#Curl command needed to move project cards -#+++++++++++++++++++++++++++++++++++++++++ - -def project_card_move(oa_token, column_id, card_id): - - """ - Currently pyGithub doesn't contain the methods required - to move project cards from one column to another, so - the unix curl command must be called directly, which is - what this function does. - - The specific command-line call made is: - - curl -H "Authorization: token OA_token" -H \ - "Accept: application/vnd.github.inertia-preview+json" \ - -X POST -d '{"position":"top", "column_id":}' \ - https://api.github.com/projects/columns/cards//moves - - """ - - #create required argument strings from inputs: - github_oa_header = ''' "Authorization: token {0}" '''.format(oa_token) - github_url_str = '''https://api.github.com/projects/columns/cards/{0}/moves'''.format(card_id) - json_post_inputs = ''' '{{"position":"top", "column_id":{}}}' '''.format(column_id) - - #Create curl command line string: - curl_cmdline = '''curl -H '''+github_oa_header+''' -H "Accept: application/vnd.github.inertia-preview+json" -X POST -d '''+\ - json_post_inputs+''' '''+github_url_str - - #Split command line string into argument list: - curl_arg_list = shlex.split(curl_cmdline) - - #Run command using subprocess: - subprocess.run(curl_arg_list, check=True) - #++++++++++++++++++++++++++++++ #Input Argument parser function #++++++++++++++++++++++++++++++ @@ -101,7 +63,7 @@ def end_script(msg): """ Prints message to screen, and then exits script. """ - print("\n{}\n".format(msg)) + print(f"\n{msg}\n") print("Issue closing check has completed successfully.") sys.exit(0) @@ -137,11 +99,10 @@ def _main_prog(): ghub = Github(token) - #++++++++++++++++++++ + #+++++++++++++++++++++ #Open ESCOMP/CAM repo - #++++++++++++++++++++ + #+++++++++++++++++++++ - #Official CAM repo: cam_repo = ghub.get_repo("ESCOMP/CAM") #+++++++++++++++++++++++++++++ @@ -162,6 +123,9 @@ def _main_prog(): #Search for merge text, starting at beginning of message: commit_msg_match = pr_merge_pattern.match(commit_message) + #Initialize variables: + pr_num = 0 + #Check if match exists: if commit_msg_match is not None: #If it does then pull out text immediately after message: @@ -174,7 +138,7 @@ def _main_prog(): first_word = post_msg_word_list[0] #Print merged pr number to screen: - print("Merged PR: {}".format(first_word)) + print(f"Merged PR: {first_word}") try: #Try assuming the word is just a number: @@ -251,6 +215,7 @@ def _main_prog(): pr_msg_lower = merged_pull.body.lower() #search for at least one keyword: + word_matches = [] if keyword_pattern.search(pr_msg_lower) is not None: #If at least one keyword is found, then determine location of every keyword instance: word_matches = keyword_pattern.finditer(pr_msg_lower) @@ -258,9 +223,9 @@ def _main_prog(): endmsg = "Pull request was merged without using any of the keywords. Thus there are no issues to close." end_script(endmsg) - #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - #Extract issue and PR numbers associated with found keywords in merged PR message - #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + #Extract issue and PR numbers associated with found keywords in merged PR message + #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ #create issue pattern ("the number symbol {#} + a number"), #which ends with either a space, a comma, a period, or @@ -268,10 +233,10 @@ def _main_prog(): issue_pattern = re.compile(r'#[0-9]+(\s|,|$)|.') #Create new "close" issues list: - close_issues = list() + close_issues = [] #Create new "closed" PR list: - close_pulls = list() + close_pulls = [] #Search text right after keywords for possible issue numbers: for match in word_matches: @@ -299,13 +264,13 @@ def _main_prog(): #so set the issue number to one that will never be found: issue_num = -9999 - #Check that number is actually for an issue (as opposed to a PR): - if issue_num in open_issues: - #Add issue number to "close issues" list: - close_issues.append(issue_num) - elif issue_num in open_pulls: - #If in fact a PR, then add to PR list: + #Check if number is actually for a PR (as opposed to an issue): + if issue_num in open_pulls: + #Add PR number to "close pulls" list: close_pulls.append(issue_num) + elif issue_num in open_issues: + #If in fact an issue, then add to "close issues" list: + close_issues.append(issue_num) #If no issue numbers are present after any of the keywords, then exit script: if not close_issues and not close_pulls: @@ -322,183 +287,26 @@ def _main_prog(): print("PRs referenced by the merged PR: "+", ".join(\ str(pull) for pull in close_pulls)) - #+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - #Determine name of project associated with merged Pull Request - #+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - #Pull-out all projects from repo: - projects = cam_repo.get_projects() - - #Initalize modified project name: - proj_mod_name = None - - #Loop over all repo projects: - for project in projects: - #Pull-out columns from each project: - proj_columns = project.get_columns() - - #Loop over columns: - for column in proj_columns: - - #check if column name is "Completed Tags" - if column.name == "Completed tags": - #If so, then extract cards: - cards = column.get_cards() - - #Loop over cards: - for card in cards: - #Extract card content: - card_content = card.get_content() - - #Next, check if card number exists and matches merged PR number: - if card_content is not None and card_content.number == pr_num: - #If so, and if Project name is None, then set string: - if proj_mod_name is None: - proj_mod_name = project.name - #Break out of card loop: - break - - #If already set, then somehow merged PR is in two different projects, - #which is not what this script is expecting, so just exit: - endmsg = "Merged Pull Request found in two different projects, so script will do nothing." - end_script(endmsg) - - #Print project name associated with merged PR: - print("merged PR project name: {}".format(proj_mod_name)) - - #++++++++++++++++++++++++++++++++++++++++ - #Extract repo project "To do" card issues - #++++++++++++++++++++++++++++++++++++++++ - - #Initalize issue counting dictionary: - proj_issues_count = dict() - - #Initalize issue id to project card id dictionary: - proj_issue_card_ids = dict() - - #Initialize list for issues that have already been closed: - already_closed_issues = list() - - #Loop over all repo projects: - for project in projects: - - #Next, pull-out columns from each project: - proj_columns = project.get_columns() - - #Loop over columns: - for column in proj_columns: - #Check if column name is "To do" - if column.name == "To do": - #If so, then extract cards: - cards = column.get_cards() - - #Loop over cards: - for card in cards: - #Extract card content: - card_content = card.get_content() - - #Next, check if card issue number matches any of the "close" issue numbers from the PR: - if card_content is not None and card_content.number in close_issues: - - #If so, then check if issue number is already in proj_issues_count: - if card_content.number in proj_issues_count: - #Add one to project issue counter: - proj_issues_count[card_content.number] += 1 - - #Also add issue id and card id to id dictionary used for card move, if in relevant project: - if project.name == proj_mod_name: - proj_issue_card_ids[card_content.number] = card.id - - else: - #If not, then append to project issues count dictionary: - proj_issues_count[card_content.number] = 1 - - #Also add issue id and card id to id dictionary used for card move, if in relevant project: - if project.name == proj_mod_name: - proj_issue_card_ids[card_content.number] = card.id - - #Otherwise, check if column name matches "closed issues" column: - elif column.name == "closed issues" and project.name == proj_mod_name: - #Save column id: - column_target_id = column.id - - #Extract cards: - closed_cards = column.get_cards() - - #Loop over cards: - for closed_card in closed_cards: - #Extract card content: - closed_card_content = closed_card.get_content() - - #Check if card issue number matches any of the "close" issue numbers from the PR: - if closed_card_content is not None and closed_card_content.number in close_issues: - #If issue number matches, then it likely means the same - #commit message or issue number reference was used in multiple - #pushes to the same repo (e.g., for a PR and then a tag). Thus - #the issue should be marked as "already closed": - already_closed_issues.append(closed_card_content.number) - - #Remove all issues from issue dictionary that are "already closed": - for already_closed_issue_num in already_closed_issues: - if already_closed_issue_num in proj_issues_count: - proj_issues_count.pop(already_closed_issue_num) - - #If no project cards are found that match the issue, then exit script: - if not proj_issues_count: - endmsg = "No project cards match the issue being closed, so the script will do nothing." - end_script(endmsg) + #++++++++++++++++++++++++++++++++++++++++++++++ + #Attempt to close all referenced issues and PRs + #++++++++++++++++++++++++++++++++++++++++++++++ - #+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - #Check if the number of "To-do" project cards matches the total number - #of merged PRs for each 'close' issue. - # - #Then, close all issues for which project cards equals merged PRs - # - #If not, then simply move the project card to the relevant project's - #"closed issues" column. - #+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - #Loop over project issues and counts that have been "closed" by merged PR: - for issue_num, issue_count in proj_issues_count.items(): - - #If issue count is just one, then close issue: - if issue_count == 1: - #Extract github issue object: - cam_issue = cam_repo.get_issue(number=issue_num) - #Close issue: - cam_issue.edit(state='closed') - print("Issue #{} has been closed.".format(issue_num)) - else: - #Extract card id from id dictionary: - if issue_num in proj_issue_card_ids: - card_id = proj_issue_card_ids[issue_num] - else: - #If issue isn't in dictionary, then it means the issue - #number was never found in the "To do" column, which - #likely means the user either referenced the wrong - #issue number, or the issue was never assigned to the - #project. Warn user and then exit with a non-zero - #error so that the Action fails: - endmsg = 'Issue #{} was not found in the "To Do" Column of the "{}" project.\n' \ - 'Either the wrong issue number was referenced, or the issue was never ' \ - 'attached to the project.'.format(issue_num, proj_mod_name) - print(endmsg) - sys.exit(1) - - #Then move the card on the relevant project page to the "closed issues" column: - project_card_move(token.strip(), column_target_id, card_id) - - #++++++++++++++++++++++++++++++++++++++++++++++++++++++ - #Finally, close all Pull Requests in "close_pulls" list: - #++++++++++++++++++++++++++++++++++++++++++++++++++++++ + #Loop over referenced issues: + for issue_num in close_issues: + #Extract github issue object: + cam_issue = cam_repo.get_issue(number=issue_num) + #Close issue: + cam_issue.edit(state='closed') + print(f"Issue #{issue_num} has been closed.") + #Loop over referenced PRs: for pull_num in close_pulls: #Extract Pull request object: cam_pull = cam_repo.get_pull(number=pull_num) #Close Pull Request: cam_pull.edit(state='closed') - print("Pull Request #{} has been closed.".format(pull_num)) + print(f"Pull Request #{pull_num} has been closed.") #++++++++++ #End script 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..922fec49be --- /dev/null +++ b/.gitmodules @@ -0,0 +1,191 @@ +[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_04_001 + 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 = release-mpasa-ew2.4 + 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.48 +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_12 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESCOMP/CESM_CICE + +[submodule "clm"] +path = components/clm +url = https://github.com/ESCOMP/CTSM +fxtag = ctsm5.2.027 +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 736dcee274..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.36 -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 = ff76a231 -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/EarthWorksOrg/rte-rrtmgp.git -tag = v1.7_ew_release_2.3 -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 dcdf858f81..df276b2bfc 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -509,8 +509,17 @@ if ($phys_mode_flags > 1) { my $simple_phys = 0; if ($adia_mode or $ideal_mode) { $simple_phys = 1; } +# If running either a simple physics or an aquaplanet configuration, the nitrogen +# deposition data is not used. These files are set in buildnml and can't be overridden +# via user_nl_cam. So provide an override here. +if ($simple_phys or $aqua_mode) { + $nl->set_variable_value('ndep_stream_nl', 'stream_ndep_data_filename', '" "'); + $nl->set_variable_value('ndep_stream_nl', 'stream_ndep_mesh_filename', '" "'); +} + # Single column mode my $scam = $cfg->get('scam'); +my $scam_iop = $cfg->get('scam_iop'); # Coupling interval # The default is for CAM to couple to the surface components every CAM timestep. @@ -569,6 +578,14 @@ if ($cfg->get('debug')) { my $prescribe_aerosols = $TRUE; if ($simple_phys) {$prescribe_aerosols = $FALSE;} +# CTSM Dust emissions scheme +my $soil_erod_atm = $FALSE; +add_default($nl, 'dust_emis_method'); +if ( $nl->get_value('dust_emis_method') =~ /Zender/ ) { + add_default($nl, 'zender_soil_erod_source'); + if ($nl->get_value('zender_soil_erod_source') =~ /atm/) {$soil_erod_atm = $TRUE;} +} + # Chemistry deposition lists if ( ($chem ne 'none') or ( $prog_species ) ){ my $chem_proc_src = $cfg->get('chem_proc_src'); @@ -615,11 +632,17 @@ if ( ($chem ne 'none') or ( $prog_species ) ){ } } if ($chem) { - # drydep_srf_file is only needed for prognostic MAM when the grid is unstructured. - # structured grids can do interpolation on the fly. - if ($chem =~ /_mam/ and ($dyn =~ /se|fv3|mpas/)) { - add_default($nl, 'drydep_srf_file'); + + # drydep_srf_file is not needed for simple physics or aquaplanet + if ( !($simple_phys or $aqua_mode) ) { + + # drydep_srf_file is only needed for prognostic MAM when the grid is unstructured. + # structured grids can do interpolation on the fly. + if ($chem =~ /_mam/ and ($dyn =~ /se|fv3|mpas/)) { + add_default($nl, 'drydep_srf_file'); + } } + add_default($nl, 'dep_data_file'); } @@ -741,7 +764,7 @@ if ($rad_pkg =~ /rrtmg/ or $chem =~ /waccm/) { elsif (!$simple_phys) { if ($chem eq 'none' and !($prog_species =~ /SO4/) ) { # Spectral solar data is needed for photolysis - # this preserves the default cam3 and cam4 configurations which do not have chemistry + # this preserves the default cam4 configuration which does not have chemistry unless (defined $nl->get_value('solar_irrad_data_file')) { add_default($nl, 'solar_const'); } @@ -820,17 +843,8 @@ if ($test_tracer_num > 0) { if ($cfg->get('age_of_air_trcs')) { add_default($nl, 'aoa_tracers_flag', 'val'=>'.true.'); } -# If phys option is "cam3" then turn on the CAM3 prescribed ozone and aerosols -if ($phys eq 'cam3' and !$aqua_mode) { - add_default($nl, 'cam3_ozone_data_on', 'val'=>'.true.'); - add_default($nl, 'cam3_aero_data_on', 'val'=>'.true.'); -} - # Defaults for radiatively active constituents -my $cam3_ozone_data = $FALSE; -my $cam3_aero_data = $FALSE; - my $moz_ozone_data = $FALSE; if (!$rad_prog_ozone) { $moz_ozone_data = $TRUE; @@ -841,24 +855,6 @@ if (!($rad_prog_ocarb) or !($rad_prog_bcarb) or !($rad_prog_sulf) or !($rad_prog $moz_aero_data = $TRUE; } -# CAM3 prescribed ozone only by request -if (defined $nl->get_value('cam3_ozone_data_on') and - $nl->get_value('cam3_ozone_data_on') =~ /$TRUE/io) { - add_default($nl, 'bndtvo'); - $cam3_ozone_data = $TRUE; - $moz_ozone_data = $FALSE; -} - -# CAM3 prescribed aerosols only by request -if (defined $nl->get_value('cam3_aero_data_on') and - $nl->get_value('cam3_aero_data_on') =~ /$TRUE/io) { - - # CAM3 aerosol mass climatology dataset (horizontal resolution dependent) - add_default($nl, 'bndtvaer'); - $cam3_aero_data = $TRUE; - $moz_aero_data = $FALSE; -} - if ($chem_rad_passive or $aqua_mode) { add_default($nl, 'atm_dep_flux', 'val'=>'.false.'); } @@ -907,8 +903,6 @@ if ($rad_prog_ozone) { add_default($nl, 'prescribed_ozone_type'); add_default($nl, 'prescribed_ozone_cycle_yr'); } -} elsif ($cam3_ozone_data =~ /$TRUE/io) { - $radval .= ",'N:O3:O3'"; } else { die "ERROR: can not set ozone rad_climate specification\n"; } @@ -1095,9 +1089,6 @@ if ($aer_model eq 'mam' ) { } elsif ($moz_aero_data =~ /$TRUE/io) { push(@aero_names, "sulf"); push(@aerosources, "N:" ); - } elsif ($cam3_aero_data =~ /$TRUE/io) { - push(@aero_names, "cam3_sul" ); - push(@aerosources, "N:" ); } else { die "ERROR: can not set sulf rad_climate specification\n"; } @@ -1108,9 +1099,6 @@ if ($aer_model eq 'mam' ) { } elsif ($moz_aero_data =~ /$TRUE/io) { push(@aero_names, "dust1", "dust2", "dust3", "dust4"); push(@aerosources, "N:", "N:", "N:", "N:" ); - } elsif ($cam3_aero_data =~ /$TRUE/io) { - push(@aero_names, "cam3_dust1", "cam3_dust2", "cam3_dust3", "cam3_dust4" ); - push(@aerosources, "N:", "N:", "N:", "N:" ); } else { die "ERROR: can not set dust rad_climate specification\n"; } @@ -1121,9 +1109,6 @@ if ($aer_model eq 'mam' ) { } elsif ($moz_aero_data =~ /$TRUE/io) { push(@aero_names, "bcar1", "bcar2"); push(@aerosources, "N:", "N:" ); - } elsif ($cam3_aero_data =~ /$TRUE/io) { - push(@aero_names, "cam3_bcpho", "cam3_bcphi"); - push(@aerosources, "N:", "N:" ); } else { die "ERROR: can not set black carbon rad_climate specification\n"; } @@ -1134,9 +1119,6 @@ if ($aer_model eq 'mam' ) { } elsif ($moz_aero_data =~ /$TRUE/io) { push(@aero_names, "ocar1", "ocar2"); push(@aerosources, "N:", "N:" ); - } elsif ($cam3_aero_data =~ /$TRUE/io) { - push(@aero_names, "cam3_ocpho", "cam3_ocphi"); - push(@aerosources, "N:", "N:" ); } else { die "ERROR: can not set organic carbon rad_climate specification\n"; } @@ -1157,9 +1139,6 @@ if ($aer_model eq 'mam' ) { push(@aero_names, "SSLTA", "SSLTC"); push(@aerosources, "N:", "N:"); } - } elsif ($cam3_aero_data =~ /$TRUE/io ) { - push(@aero_names, "cam3_ssam", "cam3_sscm"); - push(@aerosources, "N:", "N:" ); } else { die "ERROR: can not set sslt rad_climate specification\n"; } @@ -1180,7 +1159,7 @@ if ( $prescribed_aero_model ne 'none' ) { # Prescribed aerosol deposition fluxes. # Not needed if in aquaplanet mode. - if ( (($moz_aero_data =~ /$TRUE/io) or ($cam3_aero_data =~ /$TRUE/io)) and !$aqua_mode ) { + if ( $moz_aero_data =~ /$TRUE/io and !$aqua_mode ) { # If user has not set aerodep_flx_file, then use defaults unless (defined $nl->get_value('aerodep_flx_file')) { my @settings = ('aerodep_flx_datapath', 'aerodep_flx_file', 'aerodep_flx_type', @@ -1566,7 +1545,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 +1575,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')) { @@ -1786,7 +1765,7 @@ if ( $prog_species ) { add_default($nl, 'ghg_chem', 'val'=>".true."); add_default($nl, 'bndtvg'); } - if ( $prog_species =~ /DST/ ) { + if ( $prog_species =~ /DST/ and $soil_erod_atm =~ /$TRUE/) { add_default($nl, 'soil_erod_file' ); } @@ -1854,7 +1833,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; @@ -2076,9 +2055,11 @@ if ($chem =~ /geoschem/) { add_default($nl, 'flbc_cycle_yr', 'val'=>'2000'); } - my @files; # Datasets - @files = ( 'soil_erod_file', 'flbc_file' ); + my @files = ( 'flbc_file' ); + if ($soil_erod_atm =~ /$TRUE/) { + @files = ( @files, 'soil_erod_file' ); + } foreach my $file (@files) { add_default($nl, $file); } @@ -2117,12 +2098,15 @@ if ($chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) { my @files; # Datasets if ($chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) { - @files = ( 'soil_erod_file', 'flbc_file', + @files = ( 'flbc_file', 'xs_coef_file','xs_short_file','xs_long_file', 'rsf_file' ); } else { - @files = ( 'soil_erod_file', 'flbc_file', + @files = ( 'flbc_file', 'xs_coef_file','xs_short_file','xs_long_file', 'rsf_file', 'exo_coldens_file', 'sulf_file' ); } + if ($soil_erod_atm =~ /$TRUE/) { + @files = ( @files, 'soil_erod_file' ); + } foreach my $file (@files) { add_default($nl, $file); } @@ -2220,15 +2204,17 @@ if ($chem eq 'trop_mam3') { add_default($nl, 'flbc_list', 'val'=>"' '"); # Datasets - my @files = ('soil_erod_file', - 'xs_long_file', 'rsf_file', 'exo_coldens_file' ); + my @files = ( 'xs_long_file', 'rsf_file', 'exo_coldens_file' ); + if ($soil_erod_atm =~ /$TRUE/) { + @files = ( @files, 'soil_erod_file' ); + } foreach my $file (@files) { add_default($nl, $file); } } # 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 +2292,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 +2310,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 +2318,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 +2372,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 +2381,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 +2397,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', @@ -2510,7 +2502,7 @@ if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam } # MEGAN emissions - if (($chem eq 'trop_mam4' or $chem eq 'waccm_sc_mam4' or $chem eq 'ghg_mam4') and !$aqua_mode and !$scam){ + if (($chem eq 'trop_mam4' or $chem eq 'waccm_sc_mam4' or $chem eq 'ghg_mam4') and !$aqua_mode){ my $val = "'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 +'," @@ -2615,6 +2607,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'," @@ -2687,8 +2711,10 @@ if (($chem eq 'trop_mam4') or ($chem eq 'waccm_sc_mam4') or ($chem eq 'ghg_mam4' add_default($nl, 'flbc_list', 'val'=>"' '"); # Datasets - my @files = ('soil_erod_file', - 'xs_long_file', 'rsf_file', 'exo_coldens_file' ); + my @files = ('xs_long_file', 'rsf_file', 'exo_coldens_file' ); + if ($soil_erod_atm =~ /$TRUE/) { + @files = ( @files, 'soil_erod_file' ); + } foreach my $file (@files) { add_default($nl, $file); } @@ -2776,8 +2802,10 @@ if ($chem eq 'trop_mam7') { add_default($nl, 'flbc_list', 'val'=>"' '"); # Datasets - my @files = ('soil_erod_file', - 'xs_long_file', 'rsf_file', 'exo_coldens_file' ); + my @files = ('xs_long_file', 'rsf_file', 'exo_coldens_file' ); + if ($soil_erod_atm =~ /$TRUE/) { + @files = ( @files, 'soil_erod_file' ); + } foreach my $file (@files) { add_default($nl, $file); } @@ -2836,8 +2864,10 @@ if ($chem =~ /waccm_ma/ or $chem =~ /waccm_tsmlt/) { 'photon_file', 'electron_file', 'igrf_geomag_coefs_file', 'euvac_file', 'solar_parms_data_file', 'depvel_lnd_file', - 'xs_coef_file', 'xs_short_file','xs_long_file', 'rsf_file', - 'soil_erod_file' ); + 'xs_coef_file', 'xs_short_file','xs_long_file', 'rsf_file' ); + if ($soil_erod_atm =~ /$TRUE/) { + @files = ( @files, 'soil_erod_file' ); + } if (!$waccmx) { @files = (@files, 'tgcm_ubc_file', 'snoe_ubc_file' ); } @@ -3082,6 +3112,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 @@ -3148,17 +3179,18 @@ if (($chem ne 'none') and ($chem ne 'terminator') and !($chem =~ /geoschem/)) { # Deep convection scheme add_default($nl, 'deep_scheme'); +my $deep_scheme = $nl->get_value('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 $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 $deep_scheme =~ /ZM/) { add_default($nl, 'zmconv_parcel_pbl', 'val'=>'.true.'); } else { add_default($nl, 'zmconv_parcel_pbl', 'val'=>'.false.'); @@ -3211,8 +3243,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 +3258,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 +3277,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 +3389,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 +3484,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 +3549,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 +3563,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'); @@ -3672,19 +3706,15 @@ if ($cfg->get('microphys') eq 'rk') { } # Dust emissions tuning factor -# If dust is prognostic ==> supply the tuning factor -if ( length($nl->get_value('soil_erod_file'))>0 ) { - # check whether turbulent mountain stress parameterization is on - if ($nl->get_value('do_tms') =~ /$TRUE/io) { - add_default($nl, 'dust_emis_fact', 'tms'=>'1'); +# check whether turbulent mountain stress parameterization is on +if ($nl->get_value('do_tms') =~ /$TRUE/io) { + add_default($nl, 'dust_emis_fact', 'tms'=>'1'); +} else { + if ($chem =~ /trop_strat/ or $chem =~ /geoschem/ or $chem =~ /waccm_ma/ or $chem =~ /waccm_tsmlt/ or $chem =~ /trop_mozart/) { + add_default($nl, 'dust_emis_fact', 'ver'=>'chem'); } else { - if ($chem =~ /trop_strat/ or $chem =~ /geoschem/ or $chem =~ /waccm_ma/ or $chem =~ /waccm_tsmlt/ or $chem =~ /trop_mozart/) { - add_default($nl, 'dust_emis_fact', 'ver'=>'chem'); - } - else { - add_default($nl, 'dust_emis_fact'); - } + add_default($nl, 'dust_emis_fact'); } } if (chem_has_species($cfg, 'NO')) { @@ -3716,7 +3746,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 +3763,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.'); @@ -3746,12 +3780,13 @@ if (!$simple_phys) { add_default($nl, 'gw_rdg_do_divstream' , 'val'=>'.true.'); } +my $use_gw_convect_dp = '.false.'; if ($waccm_phys or - (!$simple_phys and $cfg->get('nlev') >= 60) and $dyn !~ /mpas/) { + (!$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.'); - add_default($nl, 'use_gw_convect_dp', 'val'=>'.true.'); + $use_gw_convect_dp = '.true.'; my $hdepth_scaling = '0.25D0' ; my $qbo_forcing = '.false.'; if ($dyn eq 'fv') { @@ -3770,15 +3805,19 @@ if ($waccm_phys or } add_default($nl, 'gw_qbo_hdepth_scaling', 'val'=>$hdepth_scaling); add_default($nl, 'gw_top_taper'); -} elsif ($phys =~ /cam_dev/ and $dyn !~ /mpas/) { - # 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.'); + $use_gw_convect_dp = '.true.'; add_default($nl, 'gw_qbo_hdepth_scaling', 'val'=>'1.0D0'); } else { add_default($nl, 'use_gw_front' , 'val'=>'.false.'); - add_default($nl, 'use_gw_convect_dp', 'val'=>'.false.'); } +# Check if deep convection scheme used. If not set use_gw_convect_dp=.false. +if ($deep_scheme =~ /off/) { + $use_gw_convect_dp = '.false.'; +} +add_default($nl, 'use_gw_convect_dp', 'val'=>$use_gw_convect_dp); # We need a lot of logic to use these below, so make flags for them. my $do_gw_oro = ($nl->get_value('use_gw_oro') =~ /$TRUE/io); @@ -3786,15 +3825,12 @@ 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); my $do_divstream = ($nl->get_value('gw_rdg_do_divstream') =~ /$TRUE/io); -if (!$simple_phys) { - # GW option used only for backwards compatibility with CAM3. - add_default($nl, 'fcrit2', 'val'=>'1.0'); -} # Mid-scale wavelength settings. if ($do_gw_front or $do_gw_convect_dp or $do_gw_convect_sh) { add_default($nl, 'pgwv'); @@ -3843,6 +3879,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 +3948,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.'); @@ -4038,6 +4079,30 @@ if ($dyn eq 'sld') { # Single column model if ($cfg->get('scam')) { add_default($nl, 'iopfile'); + add_default($nl, 'nhtfrq'); + add_default($nl, 'mfilt'); + add_default($nl, 'scm_use_obs_uv'); + add_default($nl, 'scale_dry_air_mass'); + add_default($nl, 'scm_relaxation'); + add_default($nl, 'scm_relax_bot_p'); + add_default($nl, 'scm_relax_top_p'); + add_default($nl, 'scm_relax_linear'); + add_default($nl, 'scm_relax_tau_bot_sec'); + add_default($nl, 'scm_relax_tau_top_sec'); + if ($chem =~ /_mam/) { + add_default($nl, 'scm_relax_fincl'); + } + if ($scam_iop) { + add_default($nl, 'iopfile'); + } + if ($scam_iop eq 'SAS') { + add_default($nl, 'use_gw_front'); + add_default($nl, 'scm_backfill_iop_w_init'); + } + if ($scam_iop eq 'twp06') { + add_default($nl, 'iradsw'); + add_default($nl, 'iradlw'); + } } # CAM generates IOP file for SCAM @@ -4103,6 +4168,7 @@ if ($dyn =~ /se/) { se_kmax_jet se_molecular_diff se_pgf_formulation + se_dribble_in_rsplit_loop ); my %opts; @@ -4191,6 +4257,7 @@ if ($dyn =~ /mpas/) { add_default($nl, 'mpas_zd'); add_default($nl, 'mpas_xnutr'); add_default($nl, 'mpas_cam_coef'); + add_default($nl, 'mpas_cam_damping_levels'); add_default($nl, 'mpas_print_detailed_minmax_vel'); add_default($nl, 'mpas_rayleigh_damp_u'); add_default($nl, 'mpas_rayleigh_damp_u_timescale_days'); @@ -4357,7 +4424,7 @@ my %nl_group = (); foreach my $name (@nl_groups) { $nl_group{$name} = ''; } # Dry deposition, MEGAN VOC emis and ozone namelists -@comp_groups = qw(drydep_inparm megan_emis_nl fire_emis_nl carma_inparm ndep_inparm ozone_coupling_nl lightning_coupling_nl); +@comp_groups = qw(drydep_inparm megan_emis_nl fire_emis_nl carma_inparm ndep_inparm ozone_coupling_nl lightning_coupling_nl dust_emis_inparm); $outfile = "$opts{'dir'}/drv_flds_in"; $nl->write($outfile, 'groups'=>\@comp_groups); @@ -5079,8 +5146,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 1dffae0d88..e13f9dff4c 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: 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. @@ -93,7 +93,7 @@ PBL package: uw (University of Washington), hb (Holtslag and Boville), hbr Radiative transfer calculation: -camrt (CAM3 and CAM4 RT package), rrtmg (RRTMG package from AER), rrtmgp (updated version). +camrt (CAM4 RT package), rrtmg (RRTMG package from AER), rrtmgp (updated version). CARMA sectional microphysics: @@ -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 @@ -147,12 +147,16 @@ Turn on CO2 cycle in biogeochemistry model: 0 => no, 1 => yes. Modifications that allow perturbation growth testing: 0=off, 1=on. -Configure CAM for single column mode: 0=off, 1=on. This option only -supported for the Eulerian dycore. +Configure CAM for single column mode and specify an IOP: 0=no, 1=yes. +This option only supported for the Eulerian and SE dycores. + + +Single column IOP +Supported for Eulerian and SE dycores. Configure CAM to generate an IOP file that can be used to drive SCAM: 0=no, 1=yes. -This option only supported for the Eulerian dycore. +Supported for Eulerian and SE dycores. Horizontal grid specifier. The recognized values depend on diff --git a/bld/configure b/bld/configure index f77b822046..707fe16e74 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 [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. @@ -124,7 +124,10 @@ OPTIONS -camiop Configure CAM to generate an IOP file that can be used to drive SCAM. This switch only works with the Eulerian dycore. - -scam Compiles model in single column mode. Only works with Eulerian dycore. + -scam Compiles model in single column mode and configures for iop + [ arm95 | arm97 | atex | bomex | cgilsS11 | cgilsS12 | cgilsS6 | dycomsRF01 | + dycomsRF02 | gateIII | mpace | rico | sparticus | togaII | twp06 | SAS | camfrc ]. + Default: arm97 CAM parallelization: @@ -209,6 +212,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 @@ -296,7 +300,7 @@ GetOptions( "psubcols=s" => \$opts{'psubcols'}, "rad=s" => \$opts{'rad'}, "offline_drv=s" => \$opts{'offline_drv'}, - "scam" => \$opts{'scam'}, + "scam=s" => \$opts{'scam'}, "silhs" => \$opts{'silhs'}, "s|silent" => \$opts{'silent'}, "smp!" => \$opts{'smp'}, @@ -534,21 +538,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 +565,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 +574,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'}) { @@ -597,8 +602,8 @@ if (defined $opts{'chem'}) { " -chem can only be set to 'none' or 'terminator'.\n"; } } - elsif ($phys_pkg =~ m/^cam3$|^cam4$|^spcam_sam1mom$/) { - # The modal aerosols are not valid with cam3 or cam4 physics + elsif ($phys_pkg =~ m/^cam4$|^spcam_sam1mom$/) { + # The modal aerosols are not valid with cam4 physics if ($chem_pkg =~ /_mam/) { die "configure ERROR: -phys=$phys_pkg -chem=$chem_pkg\n". " -chem cannot be set to a modal aerosol option.\n"; @@ -639,6 +644,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 +684,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 +821,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 +870,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 +881,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 +960,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 +1003,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 +1071,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/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. @@ -1093,12 +1102,6 @@ if ($rad_pkg eq 'camrt') { } elsif ($rad_pkg =~ m/rrtmg/) { - # The rrtmg package doesn't work with the CAM3 prescribed aerosols - if ($phys_pkg eq 'cam3') { - die "configure ERROR: radiation package: $rad_pkg is not compatible\n". - " with physics package $phys_pkg\n"; - } - # RRTMGP not currently working with CARMA if ($rad_pkg eq 'rrtmgp' and $carma_pkg ne 'none') { die "configure ERROR: The CARMA microphysics package does not currently work with RRTMGP\n"; @@ -1116,8 +1119,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"; } @@ -1201,15 +1204,25 @@ if ($print>=2) { print "Perturbation growth testing: $pergro$eol"; } #----------------------------------------------------------------------------------------------- # Single column mode + +# Set default iop +my $scam_iop; + +# Allow the user to override the default via the commandline. +if (defined $opts{'scam'}) { + $scam_iop = lc($opts{'scam'}); + $cfg_ref->set('scam_iop', $scam_iop); +} + if (defined $opts{'scam'}) { $cfg_ref->set('scam', 1); } my $scam = $cfg_ref->get('scam') ? "ON" : "OFF"; -# The only dycore supported in SCAM mode is Eulerian -if ($scam eq 'ON' and $dyn_pkg ne 'eul') { +# The only dycores supported in SCAM mode are Eulerian and Spectral Elements +if ($scam eq 'ON' and !($dyn_pkg eq 'eul' or $dyn_pkg eq 'se')) { die <<"EOF"; -** ERROR: SCAM mode only works with Eulerian dycore. +** ERROR: SCAM mode only works with Eulerian or SE dycores. ** Requested dycore is: $dyn_pkg EOF } @@ -1223,10 +1236,10 @@ if (defined $opts{'camiop'}) { } my $camiop = $cfg_ref->get('camiop') ? "ON" : "OFF"; -# The only dycore supported in CAMIOP mode is Eulerian -if ($camiop eq 'ON' and $dyn_pkg ne 'eul') { +# The only dycores supported in SCAM mode are Eulerian and Spectral Elements +if ($camiop eq 'ON' and !($dyn_pkg eq 'eul' or $dyn_pkg eq 'se')) { die <<"EOF"; -** ERROR: CAMIOP mode only works with Eulerian dycore. +** ERROR: CAMIOP mode only works with the Eulerian or Spectral Element dycores. ** Requested dycore is: $dyn_pkg EOF } @@ -1300,6 +1313,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 +1339,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 +1353,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') { @@ -1334,9 +1365,6 @@ elsif ($phys_pkg eq 'cam5' or $phys_pkg eq 'spcam_m2005') { elsif ($phys_pkg eq 'cam4' or $phys_pkg eq 'spcam_sam1mom') { $nlev = 26; } -elsif ($phys_pkg eq 'cam3') { - $nlev = 26; -} else { # This will be used for Held-Suarez and other 'simple' physics # We may change this to 32 once IC files are available. @@ -1578,7 +1606,7 @@ else { if ($print>=2 and $ttrac_nadv) { print "Advected constituents added by test tracer package: $ttrac_nadv$eol"; } if ($age_of_air_trcs eq "ON") { - $nadv += 4; + $nadv += 3; if ($print>=2) { print "Advected constituents added by the age of air tracer package: 4$eol"; } } @@ -2101,6 +2129,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 +2185,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 +2218,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 +2296,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 +2332,8 @@ 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"; + print $fh "$camsrcdir/src/atmos_phys/dry_adiabatic_adjust\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 93b7bb1101..7ee9900321 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -44,22 +44,23 @@ atm/cam/inic/cam_vcoords_L32_c180105.nc -atm/cam/inic/mpas/mpasa480_L32_notopo_coords_c201125.nc -atm/cam/inic/mpas/mpasa480_L32_notopo_coords_c240508.nc -atm/cam/inic/mpas/mpasa120_L32_notopo_coords_c201216.nc -atm/cam/inic/mpas/mpasa120_L32_notopo_coords_c240507.nc - -atm/cam/inic/mpas/mpasa120_L32_notopo_coords_c201216.nc -atm/cam/inic/mpas/mpasa120_L32_topo_coords_c201022.nc -atm/cam/inic/mpas/mpasa120_L32_topo_coords_c201022.nc -atm/cam/inic/mpas/mpasa60_L32_notopo_coords_c230707.nc -atm/cam/inic/mpas/mpasa60_L32_notopo_coords_c240507.nc -atm/cam/inic/mpas/mpasa30_L32_notopo_coords_c230707.nc -atm/cam/inic/mpas/mpasa30_L32_notopo_coords_c240507.nc - -atm/cam/inic/mpas/mpasa15_L32_notopo_coords_c240507.nc -atm/cam/inic/mpas/mpasa120_L58_notopo_coords_c240508.nc -atm/cam/inic/mpas/mpasa15_L58_notopo_coords_c240508.nc +atm/cam/inic/mpas/mpasa480_L32_notopo_coords_c240507.nc +atm/cam/inic/mpas/mpasa120_L32_notopo_coords_c240507.nc +atm/cam/inic/mpas/mpasa60_L32_notopo_coords_c240507.nc +atm/cam/inic/mpas/mpasa30_L32_notopo_coords_c240507.nc +atm/cam/inic/mpas/mpasa480_L58_notopo_coords_c240814.nc +atm/cam/inic/mpas/mpasa120_L58_notopo_coords_c240814.nc +atm/cam/inic/mpas/mpasa60_L58_notopo_coords_c240814.nc +atm/cam/inic/mpas/mpasa480_L93_notopo_coords_c240814.nc +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_L58_notopo_coords_c240814.nc +atm/cam/inic/mpas/mpasa30_L93_notopo_coords_c240814.nc +atm/cam/inic/mpas/mpasa15_L32_notopo_coords_c240911.nc +atm/cam/inic/mpas/mpasa15_L58_notopo_coords_c240911.nc +atm/cam/inic/mpas/mpasa15_L93_notopo_coords_c240911.nc + atm/cam/inic/fv/cami_0000-01-01_0.23x0.31_L26_c100513.nc @@ -135,10 +136,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 @@ -228,9 +229,15 @@ 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/CESM2.F2000climo.ne3np4.cam.i.0003-09-01-00000.nc +atm/cam/inic/se/cami_0000-01-01_ne3np4_L30_c120315.nc +atm/cam/inic/se/cami_0000-01-01_ne3np4_L30_c120315.nc +atm/cam/inic/se/cami_0000-01-01_ne3np4_L26_c120525.nc +atm/cam/inic/se/cami_0000-01-01_ne3np4_L26_c120525.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 @@ -251,7 +258,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 @@ -265,7 +272,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 @@ -284,22 +291,25 @@ atm/waccm/ic/FW2000_CONUS_30x8_L70_01-01-0001_c200602.nc -atm/waccm/ic/mpasa120km.waccm_fulltopo_c220818.nc - -atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa480_L32_CFSR_c211013.nc - -atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa120_L32_CFSR_c210426.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/waccm/ic/mpasa120_L70.waccm_topography_SC_c240904.nc + +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa480_L32_CFSR_c240508.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa120_L32_CFSR_c240508.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa480_L58_CFSR_c240814.nc +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_c240508.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa30_L32_CFSR_c240508.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa15_L32_CFSR_c240911.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa60_L58_CFSR_c240905.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa30_L58_CFSR_c240905.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa15_L58_CFSR_c240905.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa60_L93_CFSR_c240905.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa30_L93_CFSR_c240905.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa15_L93_CFSR_c240905.nc + atm/cam/topo/topo-from-cami_0000-01-01_256x512_L26_c030918.nc @@ -312,7 +322,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 @@ -338,38 +348,26 @@ atm/cam/topo/se/ne60pg2_nc3000_Co030_Fi001_PF_nullRR_Nsw021_20171014.nc atm/cam/topo/se/ne120pg2_nc3000_Co015_Fi001_PF_nullRR_Nsw010_20171012.nc atm/cam/topo/se/ne240pg2_nc3000_Co008_Fi001_PF_nullRR_Nsw005_20171014.nc - +atm/cam/topo/se/ne3np4_gmted2010_modis_bedmachine_nc0540_Laplace1000_noleak_20230717.nc 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_480_nc3000_Co240_Fi001_MulG_PF_Nsw170.nc - -atm/cam/topo/mpas/mpas_120_nc3000_Co060_Fi001_MulG_PF_Nsw042_c200921.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 - +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/mpasa60_gmted2010_modis_bedmachine_nc3000_Laplace0050_noleak_20240507.nc +atm/cam/topo/mpas/mpasa30_gmted2010_modis_bedmachine_nc3000_Laplace0025_noleak_20240507.nc +atm/cam/topo/mpas/mpasa15_gmted2010_modis_bedmachine_nc3000_Laplace0013_noleak_20240507.nc + 0.0D0 @@ -378,7 +376,7 @@ 98288.0D0 98288.0D0 98288.0D0 - 98288.0D0 + 98288.0D0 98288.0D0 98288.0D0 @@ -428,19 +426,6 @@ - -atm/cam/physprops/sul_cam3_c080918.nc -atm/cam/physprops/dustv1b1_cam3_c080918.nc -atm/cam/physprops/dustv1b2_cam3_c080918.nc -atm/cam/physprops/dustv1b3_cam3_c080918.nc -atm/cam/physprops/dustv1b4_cam3_c080918.nc -atm/cam/physprops/bcpho_cam3_c080918.nc -atm/cam/physprops/bcphi_cam3_c080918.nc -atm/cam/physprops/ocpho_cam3_c080918.nc -atm/cam/physprops/ocphi_cam3_c080918.nc -atm/cam/physprops/ssam_cam3_c080918.nc -atm/cam/physprops/sscm_cam3_c080918.nc - atm/cam/physprops/sulfate_camrt_c080918.nc @@ -605,7 +590,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 @@ -625,7 +610,7 @@ .false. .true. -.true. +.true. slingo @@ -671,9 +656,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 @@ -883,6 +868,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 @@ -912,8 +898,8 @@ .true. .true. .true. -.false. -.false. +.false. +.false. .false. .false. .false. @@ -933,6 +919,7 @@ 1.0d-3 0.002d0 0.1d0 + 0.01d0 15 @@ -970,6 +957,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 @@ -981,10 +969,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 @@ -1968,10 +1956,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 @@ -2013,12 +2001,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 @@ -2029,6 +2017,8 @@ OFF + +atm/cam/chem/trop_mam/atmsrf_ne3np4_230718.nc atm/cam/chem/trop_mam/atmsrf_ne3np4.pg3_221214.nc atm/cam/chem/trop_mam/atmsrf_ne5np4_110920.nc atm/cam/chem/trop_mam/atmsrf_ne5pg3_201105.nc @@ -2103,7 +2093,7 @@ .true. .true. .false. - .false. + .false. .true. 0.075D0 @@ -2115,20 +2105,20 @@ .false. .true. - .true. + .true. .false. .true. .true. - .true. + .true. .true. 0 1 1 - 1 + 1 1 0.01d0 @@ -2157,6 +2147,7 @@ 2.4 + 5.0 1.0 1.0 0.7D0 @@ -2174,9 +2165,10 @@ 6.0 1.0 0.5 - 0.1 + 0.1 0.5 4.2 + 4.25 0.0 1.0 0.1 @@ -2193,35 +2185,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. @@ -2233,17 +2234,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. @@ -2259,9 +2266,12 @@ 1 2.0 60.0 + 0.5 + 25.0 .false. -.true. .true. +.true. + .true. 0.2 @@ -2287,6 +2297,7 @@ 10.0 4.0 0.0 + 5.0 .true. .false. @@ -2305,6 +2316,9 @@ .false. .false. .false. + 0.5 + 25.00 + .false. @@ -2376,15 +2390,14 @@ 1.D0 1.D0 - 0.375D0 1.D0 0.2D0 - 0.1D0 + 0.1D0 0.1D0 - 0.0D0 + 0.0D0 0.001D0 @@ -2403,10 +2416,10 @@ 1.D8 1.D8 - .true. - .true. - kk2000 - .true. + .true. + .true. + kk2000 + .true. 1 3 @@ -2439,17 +2452,17 @@ .false. .true. -.true. +.true. 0.01D0 0.05D0 .false. .true. -.true. +.true. .true. .false. -.false. +.false. 1.0D0 .true. @@ -2481,7 +2494,7 @@ 1.D0 0.D0 0.D0 -0.D0 +0.D0 1.D0 @@ -2491,12 +2504,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 @@ -2516,51 +2529,55 @@ 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 + + +Zender_2003 +atm @@ -2568,7 +2585,7 @@ 1.62D0 0.90D0 1.00D0 -1.5D0 +1.5D0 1.10D0 1.2D0 0.60D0 @@ -2676,7 +2693,7 @@ .false. .true. .true. -.true. +.true. 0.900D0 0.910D0 @@ -2696,12 +2713,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 @@ -2715,7 +2732,7 @@ 0.100D0 0.000D0 - 0.000D0 + 0.000D0 0.000D0 0.800D0 @@ -2739,7 +2756,7 @@ 0.14D0 0.10D0 0.10D0 - 0.10D0 + 0.10D0 0.10D0 0.10D0 @@ -2764,25 +2781,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 @@ -2800,17 +2817,15 @@ 1.0D0 1.e-7 -5.e-6 5.e-3 .false. .false. .true. -.true. +.true. .false. -.true. 5.0e-6 @@ -2888,11 +2903,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 @@ -2909,11 +2924,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 @@ -2937,7 +2952,7 @@ 5 1 - 1 + 1 -1.0E-3 0.5 @@ -2953,13 +2968,12 @@ 0.5D0 -0 1 2 4 4 - 4 + 4 4 42 42 @@ -2969,9 +2983,9 @@ 42 42 42 -42 +42 42 -42 +42 42 1 @@ -3006,12 +3020,141 @@ -atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc -atm/cam/scam/iop/ARM97_4scam.nc - 1500 - 9 - .true. - slt + 1 + 10000 + .true. + 0.0D0 + .true. + 10800._r8 + + 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', 'ncl_a3', + 'num_a1', 'num_a2', 'num_a3', 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' + + + 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', 'ncl_a3', + 'num_a1', 'num_a2', 'num_a3', 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' + + + 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', 'ncl_a3', + 'num_a1', 'num_a2', 'num_a3', 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' + + 105000.D0 + 200.D0 + .true. + 864000.D0 + 172800.D0 + + + + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-06-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-06-01-00000.nc +atm/cam/scam/iop/ARM95_4scam.nc + 368.9e-6 + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-06-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-06-01-00000.nc +atm/cam/scam/iop/ARM97_4scam.nc + 368.9e-6 + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-02-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-02-01-00000.nc +atm/cam/scam/iop/ATEX_48hr_4scam.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-06-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-06-01-00000.nc +atm/cam/scam/iop/BOMEX_5day_4scam.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-07-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-07-01-00000.nc +atm/cam/scam/iop/S11_CTL_MixedLayerInit_reduced.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-07-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-07-01-00000.nc +atm/cam/scam/iop/S12_CTL_MixedLayerInit_reduced.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-07-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-07-01-00000.nc +atm/cam/scam/iop/S6_CTL_reduced.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-07-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-07-01-00000.nc +atm/cam/scam/iop/DYCOMSrf01_4day_4scam.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-07-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-07-01-00000.nc +atm/cam/scam/iop/DYCOMSrf02_48hr_4scam.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-08-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-08-01-00000.nc +atm/cam/scam/iop/GATEIII_4scam_c170809.nc + + +atm/cam/scam/iop/micre2017_3mo.cam.i.2017-01-01-00000.regrid.ne3np4.nc +atm/cam/scam/iop/micre2017_3mo.cam.i.2017-01-01-00000.regrid.Gaus_64x128.nc +atm/cam/scam/iop/micre2017_3mo.macquarie2017.iop.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-10-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-10-01-00000.nc +atm/cam/scam/iop/MPACE_4scam.nc + + 'CLDST', 'CNVCLD', + 'ICWMR','ICIMR','FREQL','FREQI','LANDFRAC','CDNUMC','FICE','WSUB','CCN3','ICLDIWP', + 'CDNUMC', 'AQSNOW', 'WSUB', 'CCN3', 'FREQI', 'FREQL', 'FREQR', 'FREQS', 'CLDLIQ', 'CLDICE', + 'FSDS', 'FLDS','AREL','AREI','NSNOW','QSNOW','DSNOW', + 'FLNT','FLNTC','FSNT','FSNTC','FSNS','FSNSC','FLNT','FLNTC','QRS','QRSC','QRL','QRLC', + 'LWCF','SWCF', 'NCAI', 'NCAL', 'NIHF','NIDEP','NIIMM','NIMEY','ICLDIWP','ICLDTWP', 'CONCLD', + 'QCSEVAP', 'QISEVAP', 'QVRES', 'CMELIQ', 'CMEIOUT', 'EVAPPREC', 'EVAPSNOW', 'TAQ', + 'ICLMRCU', 'ICIMRCU' ,'ICWMRSH' ,'ICWMRDP', 'ICLMRTOT' , 'ICIMRTOT' , 'SH_CLD' , 'DP_CLD', + 'LIQCLDF','ICECLDF', 'ICWMRST', 'ICIMRST', 'EFFLIQ', 'EFFICE','ADRAIN','ADSNOW','WSUBI', + 'TGCLDLWP','GCLDLWP' + + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-07-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-07-01-00000.nc +atm/cam/scam/iop/RICO_3day_4scam.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-06-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-06-01-00000.nc +atm/cam/scam/iop/SAS_ideal_4scam.nc + 368.9e-6 + .false. + .true. + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-04-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-04-01-00000.nc +atm/cam/scam/iop/SPARTICUS_4scam.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-12-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-12-01-00000.nc +atm/cam/scam/iop/TOGAII_4scam.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-01-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-01-01-00000.nc +atm/cam/scam/iop/TWP06_4scam.nc + 1 + 1 + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-06-01-00000.nc +atm/cam/inic/gaus/CESM2.F2000climo.64x128.cam.i.0003-06-01-00000.nc +atm/cam/scam/iop/ARM97_4scam.nc @@ -3119,9 +3262,9 @@ 3 3 5 - 5 + 5 6 - 6 + 6 1 1 3 @@ -3178,6 +3321,10 @@ 1 3 + + 0 + 1 + 2 .true. @@ -3187,15 +3334,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 @@ -3209,9 +3362,11 @@ 1.9 -1 +6.e15 5.e15 -1 +6.e15 10.e15 -1 @@ -3219,12 +3374,14 @@ 1.25e5 1.0e6 1.0e6 + 1.0e6 0.0 1.0 -1 -1 + 7.5 -1 1 @@ -3239,17 +3396,17 @@ 1 3 - 5 - 3 - 5 - 3 + 5 + 2 + 4 + 2 10 7 3 - 4 - 6 + 2 + 4 3 -1 @@ -3371,6 +3528,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 + ', @@ -3482,6 +3647,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 7e908911b8..af5f067f86 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -476,20 +476,6 @@ Default: none - - - -Full pathname of time-variant boundary dataset for aerosol masses. -Default: set by build-namelist. - - - -Add CAM3 prescribed aerosols to the physics buffer. -Default: FALSE - - -1 for FFT filter always, 0 for combined algebraic/FFT filter. The value 0 -is used for CAM3, otherwise it is using the value 1. +1 for FFT filter always, 0 for combined algebraic/FFT filter. Default: set by build-namelist @@ -1332,6 +1317,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). @@ -1489,12 +1480,6 @@ Full pathname of boundary dataset for meso-gamma ridges. Default: set by build-namelist. - -Critical Froude number squared (used only for orographic waves). -Default: set by build-namelist. - - Factor to multiply tau by, for orographic waves in the southern hemisphere. @@ -1533,6 +1518,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 +1539,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 +3603,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 +3771,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 +4015,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 +4047,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 +4070,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 +4096,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 +4123,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 +4222,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 +4236,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 +4253,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 +4265,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 +4288,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 +4304,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 +4331,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 +4423,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) + + @@ -4790,30 +4892,6 @@ Specifies the name of the sea salt emission parameterization. Default: Gong - -======= - - - -Full pathname of time-variant ozone mixing ratio boundary dataset. -Default: set by build-namelist. - - - -Add CAM3 prescribed ozone to the physics buffer. -Default: FALSE - - - -Flag for yearly cycling of ozone data. If set to FALSE, a multi-year -dataset is assumed, otherwise a single-year dataset is assumed, and ozone -will be cycled over the 12 monthly averages in the file. -Default: TRUE - - + group="phys_ctl_nl" valid_values="cam4,cam5,cam6,adiabatic,held_suarez,kessler,frierson" > Name of the CAM physics package. 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. @@ -5879,6 +5957,12 @@ Use the SCAM-IOP specified observed water vapor at each time step instead of for Default: FALSE + +Use the SCAM-IOP 3d forcing if true, use combination of dycore vertical advection and iop horiz advection if false +Default:False + + Force scam to use the lat lon fields specified in the scam namelist not what is closest to IOP avail lat lon @@ -7575,6 +7659,21 @@ List of fluxes needed by the CARMA model, from CLM to CAM. Default: set by build-namelist. + +Which dust emission method is going to be used. +Either the Zender 2003 scheme or the Leung 2023 scheme. +Default: Zender_2003 + + + +Option only applying for the Zender_2003 method for whether the soil erodibility +file is handled in the active LAND model or in the ATM model. +(only used when dust_emis_method is Zender_2003) +Default: atm + + + + + 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. + + @@ -8478,15 +8591,26 @@ Default: 0.2 -Coefficient for scaling the 2nd-order horizontal diffusion in the mpas_cam absorbing layer. -A value of 1.0 will result in layered diffusion similar to CAM-SE and gives damping -coefficients of 0.2216E7, 0.6482E6, 0.1927E6 in the top-most three layers on the dynamics -variables u, w, and theta. The top 3 damping coefficients scale linearly with -mpas_cam_coef. 0.0 disables SE like 2nd-order diffusion in the absorbing layer and is the -current default. Sponge layer absorption can also be provided by Rayleigh damping. +Coefficient for scaling the 2nd-order horizontal diffusion in the mpas_cam absorbing +layer. The absorbing layer depth is controlled with mpas_cam_damping_levels. The damping +coefficients scale linearly with mpas_cam_coef. A value of 0.0 (or +mpas_cam_damping_levels=0) disables the 2nd-order diffusion in the absorbing layer. Sponge +layer absorption can also be provided by Rayleigh damping. + +E.g. a value of 1.0 with mpas_cam_damping_levels=3 will result in damping coefficients of +2E6 m^2/s, 6E5, 2E5 in the top-most three layers on the dynamics variables u, w, and +theta. Default: 0.0 + +Number mpas_cam absorbing layers in which to apply 2nd-order horizontal diffusion. +Viscocity linearly ramps to zero by layer number from the top. mpas_cam_damping_levels and +mpas_cam_coef must both be greater than 0 for the diffusion to be enabled. +Default: 0 + + Whether to apply Rayleigh damping on horizontal velocity in the top-most model levels. @@ -9373,36 +9497,4 @@ If TRUE perform temp tendency scaling before send to fv3 dynamics Default: FALSE - - - - - - - - -Stream filename(s) for Nitrogen Deposition data - - - -Stream meshfile for Nitrogen Deposition data - - - -First year to loop over for Nitrogen Deposition data - - - -Last year to loop over for Nitrogen Deposition data - - - -Simulation year that aligns with stream_year_first_ndep value - - diff --git a/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml b/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml index 52349f423b..15306d5711 100644 --- a/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml +++ b/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml @@ -85,7 +85,7 @@ 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', - 'ALATM', 'ALONM', 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', + 'ALATM', 'ALONM', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC','FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', diff --git a/bld/namelist_files/use_cases/aquaplanet_cam3.xml b/bld/namelist_files/use_cases/aquaplanet_cam3.xml deleted file mode 100644 index 373b2ad18d..0000000000 --- a/bld/namelist_files/use_cases/aquaplanet_cam3.xml +++ /dev/null @@ -1,77 +0,0 @@ - - - - - -300 -150 - - -0. -0. -0. -fixed_parameters - - - false - - -348.0e-6 -1650.0e-9 -306.0e-9 -280.e-12 -503.e-12 - - - .false. - - - 4.0e-4 - 16.0e-6 - 5.0e-6 - 0.910D0 - 0.700D0 - 0.070D0 - 500.0D0 - 0.140D0 - 500.0D0 - 25000.0D0 - 1800.0D0 - 1.0e-4 - 0.0040D0 - 0.0040D0 - 1.0E-6 - - - -1365.0 -/ - - -apeozone_cam3_5_54.nc -atm/cam/ozone -OZONE -CYCLICAL -1990 - - - - - -86164.10063718943 -6.37100e6 -9.79764 -28.96623324623746 -18.01618112892741 -1.846e3 -273.16 - -'A:Q:H2O', 'N:O2:O2', 'N:CO2:CO2', 'N:ozone:O3', 'N:N2O:N2O', 'N:CH4:CH4', 'N:CFC11:CFC11','N:CFC12:CFC12' - - - 0.5 - - - 0 - - 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_cam_lt.xml b/bld/namelist_files/use_cases/hist_cam_lt.xml index 81834955c3..c436b97c1f 100644 --- a/bld/namelist_files/use_cases/hist_cam_lt.xml +++ b/bld/namelist_files/use_cases/hist_cam_lt.xml @@ -13,7 +13,7 @@ 'Q:H2O->UBC_FILE' -atm/cam/chem/ubc/f.e21.FWHISTBgcCrop.f09_f09_mg17.CMIP6-AMIP-WACCM.ensAvg123.cam.h0zm.UBC.195001-201412_c220322.nc +atm/cam/chem/ubc/b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensAvg123.cam.h0zm.H2O.1849-2014_c240604.nc 'SERIAL' 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/scam_arm95.xml b/bld/namelist_files/use_cases/scam_arm95.xml deleted file mode 100644 index bf9ebc7391..0000000000 --- a/bld/namelist_files/use_cases/scam_arm95.xml +++ /dev/null @@ -1,22 +0,0 @@ - - - - - -368.9e-6 - -atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc -atm/cam/scam/iop/ARM95_4scam.nc - 36.6 - 262.5 - 19950718 - 19800 - 1259 - 1500 - 1 - nsteps - - -2000 - - diff --git a/bld/namelist_files/use_cases/scam_arm97.xml b/bld/namelist_files/use_cases/scam_arm97.xml deleted file mode 100644 index 7508853f08..0000000000 --- a/bld/namelist_files/use_cases/scam_arm97.xml +++ /dev/null @@ -1,22 +0,0 @@ - - - - - -368.9e-6 - -atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc -atm/cam/scam/iop/ARM97_4scam.nc - 36.6 - 262.5 - 19970618 - 84585 - 2088 - 1500 - 9 - nsteps - - -2000 - - diff --git a/bld/namelist_files/use_cases/scam_gateIII.xml b/bld/namelist_files/use_cases/scam_gateIII.xml deleted file mode 100644 index c5c822d5e3..0000000000 --- a/bld/namelist_files/use_cases/scam_gateIII.xml +++ /dev/null @@ -1,20 +0,0 @@ - - - - - -atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc -atm/cam/scam/iop/GATEIII_4scam.nc - 9.00 - 336.0 - 19740830 - 0 - 1440 - 1500 - 9 - nsteps - - -2000 - - diff --git a/bld/namelist_files/use_cases/scam_mpace.xml b/bld/namelist_files/use_cases/scam_mpace.xml deleted file mode 100644 index a559a8489e..0000000000 --- a/bld/namelist_files/use_cases/scam_mpace.xml +++ /dev/null @@ -1,30 +0,0 @@ - - - - - -atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc -atm/cam/scam/iop/MPACE_4scam.nc - 70.5 - 206.0 - 20041005 - 7171 - 1242 - 1500 - 9 - nsteps - 'CLDST', 'CNVCLD', - 'ICWMR','ICIMR','FREQL','FREQI','LANDFRAC','CDNUMC','FICE','WSUB','CCN3','ICLDIWP', - 'CDNUMC', 'AQSNOW', 'WSUB', 'CCN3', 'FREQI', 'FREQL', 'FREQR', 'FREQS', 'CLDLIQ', 'CLDICE', - 'FSDS', 'FLDS','AREL','AREI','NSNOW','QSNOW','DSNOW', - 'FLNT','FLNTC','FSNT','FSNTC','FSNS','FSNSC','FLNT','FLNTC','QRS','QRSC','QRL','QRLC', - 'LWCF','SWCF', 'NCAI', 'NCAL', 'NIHF','NIDEP','NIIMM','NIMEY','ICLDIWP','ICLDTWP', 'CONCLD', - 'QCSEVAP', 'QISEVAP', 'QVRES', 'CMELIQ', 'CMEIOUT', 'EVAPPREC', 'EVAPSNOW', 'TAQ', - 'ICLMRCU', 'ICIMRCU' ,'ICWMRSH' ,'ICWMRDP', 'ICLMRTOT' , 'ICIMRTOT' , 'SH_CLD' , 'DP_CLD', - 'LIQCLDF','ICECLDF', 'ICWMRST', 'ICIMRST', 'EFFLIQ', 'EFFICE','ADRAIN','ADSNOW','WSUBI', - 'TGCLDLWP','GCLDLWP' - - -2000 - - diff --git a/bld/namelist_files/use_cases/scam_sparticus.xml b/bld/namelist_files/use_cases/scam_sparticus.xml deleted file mode 100644 index 105994b36b..0000000000 --- a/bld/namelist_files/use_cases/scam_sparticus.xml +++ /dev/null @@ -1,20 +0,0 @@ - - - - - -atm/cam/inic/gaus/cami_0000-01-01_64x128_L30_c090102.nc -atm/cam/scam/iop/SPARTICUS_4scam.nc - 36.6 - 262.51 - 20100401 - 3599 - 2156 - 1500 - 9 - nsteps - - -2000 - - diff --git a/bld/namelist_files/use_cases/scam_togaII.xml b/bld/namelist_files/use_cases/scam_togaII.xml deleted file mode 100644 index 9b2706382b..0000000000 --- a/bld/namelist_files/use_cases/scam_togaII.xml +++ /dev/null @@ -1,20 +0,0 @@ - - - - - -atm/cam/inic/gaus/cami_0000-01-01_64x128_L30_c090102.nc -atm/cam/scam/iop/TOGAII_4scam.nc - -2.10 - 154.69 - 19921218 - 64800 - 1512 - 1500 - 9 - nsteps - - -2000 - - diff --git a/bld/namelist_files/use_cases/scam_twp06.xml b/bld/namelist_files/use_cases/scam_twp06.xml deleted file mode 100644 index e599a45b16..0000000000 --- a/bld/namelist_files/use_cases/scam_twp06.xml +++ /dev/null @@ -1,20 +0,0 @@ - - - - - -atm/cam/inic/gaus/cami_0000-01-01_64x128_L30_c090102.nc -atm/cam/scam/iop/TWP06_4scam.nc - -12.43 - 130.89 - 20060117 - 10800 - 1926 - 1500 - 9 - nsteps - - -2000 - - diff --git a/bld/namelist_files/use_cases/sd_waccm_ma_cam4.xml b/bld/namelist_files/use_cases/sd_waccm_ma_cam4.xml index 6fa2495972..95b9e204db 100644 --- a/bld/namelist_files/use_cases/sd_waccm_ma_cam4.xml +++ b/bld/namelist_files/use_cases/sd_waccm_ma_cam4.xml @@ -92,7 +92,7 @@ - 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', diff --git a/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml b/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml index 8adf1f6333..753c2e0035 100644 --- a/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml +++ b/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml @@ -71,7 +71,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', diff --git a/bld/namelist_files/use_cases/sd_waccm_sulfur.xml b/bld/namelist_files/use_cases/sd_waccm_sulfur.xml index 25c4d622de..7a02c11544 100644 --- a/bld/namelist_files/use_cases/sd_waccm_sulfur.xml +++ b/bld/namelist_files/use_cases/sd_waccm_sulfur.xml @@ -67,7 +67,7 @@ - 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', + 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'CO2', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', @@ -103,7 +103,7 @@ 'CL','CL2', 'CLO', 'OCLO', 'CL2O2', 'CLONO2', 'HOCL', 'HCL', 'CLOX', 'CLOY', 'BR', 'BRO', 'HOBR', 'HBR', 'BRCL', 'BRONO2', 'BROX', 'BROY', 'TCLY', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jhocl', 'jno3_b', 'jcl2o2', - 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE','AOA1','AOA2', + 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE', 'O2', 'CLDLIQ', 'CLDICE', 'ASDIR', 'VTHzm', 'WTHzm', 'UVzm', 'UWzm', 'TH', 'MSKtem' diff --git a/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml b/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml index e52fd92caa..9da740a7ae 100644 --- a/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +++ b/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml @@ -65,10 +65,10 @@ .true. .true. - 'AOA1SRC', 'AOA2SRC', 'NO2_CMXF' + 'NO2_CMXF' - 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AOA_NH', 'AODABSdn', 'AODBCdn', 'AODdnDUST01', 'AODdnDUST02', + 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA_NH', 'AODABSdn', 'AODBCdn', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODdn_aitken', 'AODdn_accum', 'AODdn_coarse', 'AODDUST02', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', 'AODUVdn', 'AODUVstdn', 'AODVIS', 'AODVISdn', 'AODVISstdn', 'AQ_SO2', 'AREA', 'AREI', 'AREL', 'bc_a1', 'bc_a1DDF', 'bc_a1SFWET', 'bc_a4', 'bc_a4_CLXF', 'bc_a4DDF', 'bc_a4SFWET', 'BCARY', 'bc_c1', 'bc_c1DDF', 'bc_c1SFWET', 'bc_c4', 'bc_c4DDF', diff --git a/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml b/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml index 56b964bc54..6ec178700a 100644 --- a/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml +++ b/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml @@ -85,7 +85,7 @@ 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', - 'ALATM', 'ALONM', 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', + 'ALATM', 'ALONM', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC','FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 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..6493ed584b 100644 --- a/bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml +++ b/bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml @@ -72,7 +72,7 @@ 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', - 'ALATM', 'ALONM', 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', + 'ALATM', 'ALONM', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC','FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', @@ -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/soa_chem_megan_emis.xml b/bld/namelist_files/use_cases/soa_chem_megan_emis.xml index 512d95fcc9..5497ed52a9 100644 --- a/bld/namelist_files/use_cases/soa_chem_megan_emis.xml +++ b/bld/namelist_files/use_cases/soa_chem_megan_emis.xml @@ -63,7 +63,7 @@ NEU - 'AEROD_v', 'AOA1', 'AOA2', 'CH2O', 'CH3O2', 'CH3OOH', 'CH4', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLOUD', + 'AEROD_v', 'CH2O', 'CH3O2', 'CH3OOH', 'CH4', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLOUD', 'CO', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'H', 'H2', 'H2O2', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'HNO3', 'HO2', 'HO2NO2', 'LANDFRAC', 'LHFLX', 'N2O', 'N2O5', 'NO', 'NO2', 'NO3', 'O', 'O1D', 'O3', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'Q', 'QRL', 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', diff --git a/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml b/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml index a6e5287553..1429770e8e 100644 --- a/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml +++ b/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml @@ -77,7 +77,7 @@ - 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', + 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'CO2', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', @@ -113,7 +113,7 @@ 'CL','CL2', 'CLO', 'OCLO', 'CL2O2', 'CLONO2', 'HOCL', 'HCL', 'CLOX', 'CLOY', 'BR', 'BRO', 'HOBR', 'HBR', 'BRCL', 'BRONO2', 'BROX', 'BROY', 'TCLY', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jhocl', 'jno3_b', 'jcl2o2', - 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE','AOA1','AOA2', + 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE', 'O2', 'CLDLIQ', 'CLDICE', 'ASDIR', 'VTHzm', 'WTHzm', 'UVzm', 'UWzm', 'TH', 'MSKtem' diff --git a/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml b/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml index 99eb24d6b8..24b55facc2 100644 --- a/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml @@ -55,7 +55,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', diff --git a/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml b/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml index f87670c6b0..9ccac8892f 100644 --- a/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml @@ -150,7 +150,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', diff --git a/bld/namelist_files/use_cases/waccm_ma_hist_cam4.xml b/bld/namelist_files/use_cases/waccm_ma_hist_cam4.xml index 1177ebd155..e2376e4a70 100644 --- a/bld/namelist_files/use_cases/waccm_ma_hist_cam4.xml +++ b/bld/namelist_files/use_cases/waccm_ma_hist_cam4.xml @@ -78,7 +78,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', diff --git a/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml b/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml index 03c45f097a..042a153fe4 100644 --- a/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml @@ -49,7 +49,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', diff --git a/bld/namelist_files/use_cases/waccm_sc_1850_cam6.xml b/bld/namelist_files/use_cases/waccm_sc_1850_cam6.xml index a004dafd78..dbc6b0921b 100644 --- a/bld/namelist_files/use_cases/waccm_sc_1850_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_sc_1850_cam6.xml @@ -72,7 +72,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', + 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', 'UTGWSPEC', 'VTGWSPEC', 'BUTGWSPEC', 'AODVISstdn', 'AODVISdn', 'KVH_CLUBB', 'KVH', 'TTENDICE', 'QVTENDICE', 'QCTENDICE', 'NCTENDICE', 'FQTENDICE', 'MASS' diff --git a/bld/namelist_files/use_cases/waccm_sc_2000_cam6.xml b/bld/namelist_files/use_cases/waccm_sc_2000_cam6.xml index cdb217a987..ead1445075 100644 --- a/bld/namelist_files/use_cases/waccm_sc_2000_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_sc_2000_cam6.xml @@ -21,8 +21,8 @@ 'CO2','CH4','N2O','CFC11','CFC12','CFC11eq' -FIXED -20000101 +CYCLICAL +2000 SCWACCM_forcing_WACCM6_zm_5day_L70_1975-2014_c191121.nc atm/waccm/waccm_forcing @@ -107,7 +107,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', + 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', 'UTGWSPEC', 'VTGWSPEC', 'BUTGWSPEC', 'AODVISstdn', 'AODVISdn', 'KVH_CLUBB', 'KVH', 'TTENDICE', 'QVTENDICE', 'QCTENDICE', 'NCTENDICE', 'FQTENDICE', 'MASS' diff --git a/bld/namelist_files/use_cases/waccm_sc_2010_cam6.xml b/bld/namelist_files/use_cases/waccm_sc_2010_cam6.xml index d878ba8f6d..9b168bbef2 100644 --- a/bld/namelist_files/use_cases/waccm_sc_2010_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_sc_2010_cam6.xml @@ -21,8 +21,8 @@ 'CO2','CH4','N2O','CFC11','CFC12','CFC11eq' -FIXED -20100101 +CYCLICAL +2010 SCWACCM_forcing_WACCM6_zm_5day_L70_1975-2014_c191121.nc atm/waccm/waccm_forcing @@ -110,7 +110,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', + 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', 'UTGWSPEC', 'VTGWSPEC', 'BUTGWSPEC', 'AODVISstdn', 'AODVISdn', 'KVH_CLUBB', 'KVH', 'TTENDICE', 'QVTENDICE', 'QCTENDICE', 'NCTENDICE', 'FQTENDICE', 'MASS' diff --git a/bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml b/bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml index cad2fb3f3a..3c2583af96 100644 --- a/bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml @@ -59,7 +59,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', + 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', 'UTGWSPEC', 'VTGWSPEC', 'BUTGWSPEC', 'AODVISstdn', 'AODVISdn', 'KVH_CLUBB', 'KVH', 'TTENDICE', 'QVTENDICE', 'QCTENDICE', 'NCTENDICE', 'FQTENDICE', 'MASS' diff --git a/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml b/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml index 800b9b228a..86e6af3bab 100644 --- a/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml @@ -63,7 +63,7 @@ .true. .true. - 'AOA1SRC', 'AOA2SRC', 'NO2_CMXF', 'NO2_CLXF' + 'NO2_CMXF', 'NO2_CLXF' 'ACTREL', 'AQ_SO2', 'AREA', 'BROX', 'BROY', 'BRY', 'CLOX', 'CLOY', 'CLY', 'NOX', 'NOY', 'TBRY', 'TCLY', 'CFC11STAR', diff --git a/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml b/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml index 3ad0c7db31..efc485e990 100644 --- a/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml @@ -260,7 +260,7 @@ .true. .true. - 'AOA1SRC', 'AOA2SRC', 'NO2_CMXF' + 'NO2_CMXF' 'ACTREL', 'AQ_SO2', 'AREA', 'BROX', 'BROY', 'BRY', 'CLOX', 'CLOY', 'CLY', 'NOX', 'NOY', 'TBRY', 'TCLY', 'CFC11STAR', diff --git a/bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml b/bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml index 219083b1a4..fa65883ce1 100644 --- a/bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml @@ -160,7 +160,7 @@ .true. .true. - 'AOA1SRC', 'AOA2SRC', 'NO2_CMXF' + 'NO2_CMXF' 'ACTREL', 'AQ_SO2', 'AREA', 'BROX', 'BROY', 'BRY', 'CLOX', 'CLOY', 'CLY', 'NOX', 'NOY', 'TBRY', 'TCLY', 'CFC11STAR', diff --git a/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml b/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml index 6ad0b14145..00fb808a52 100644 --- a/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml @@ -56,7 +56,7 @@ .true. .true. - 'AOA1SRC', 'AOA2SRC', 'NO2_CMXF' + 'NO2_CMXF' 'ACTREL', 'AQ_SO2', 'AREA', 'BROX', 'BROY', 'BRY', 'CLOX', 'CLOY', 'CLY', 'NOX', 'NOY', 'TBRY', 'TCLY', 'CFC11STAR', 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..017cc3362e 100644 --- a/bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml +++ b/bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml @@ -74,7 +74,7 @@ - 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', + 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'CO2', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', @@ -110,9 +110,8 @@ 'CL','CL2', 'CLO', 'OCLO', 'CL2O2', 'CLONO2', 'HOCL', 'HCL', 'CLOX', 'CLOY', 'BR', 'BRO', 'HOBR', 'HBR', 'BRCL', 'BRONO2', 'BROX', 'BROY', 'TCLY', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jhocl', 'jno3_b', 'jcl2o2', - 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE','AOA1','AOA2', + 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE', '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', @@ -122,7 +121,7 @@ - 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', + 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'CO2', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', diff --git a/bld/namelist_files/use_cases/waccmx_ma_2000_cam6.xml b/bld/namelist_files/use_cases/waccmx_ma_2000_cam6.xml index 6e6986f127..06520cc3fb 100644 --- a/bld/namelist_files/use_cases/waccmx_ma_2000_cam6.xml +++ b/bld/namelist_files/use_cases/waccmx_ma_2000_cam6.xml @@ -52,7 +52,7 @@ 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'T_08_COS', 'T_08_SIN', 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', - 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', 'ALATM', 'ALONM', 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', + 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', 'ALATM', 'ALONM', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', 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..37ca427cd2 100644 --- a/bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml +++ b/bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml @@ -50,7 +50,7 @@ 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'T_08_COS', 'T_08_SIN', 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', - 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', 'ALATM', 'ALONM', 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', + 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', 'ALATM', 'ALONM', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', @@ -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/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml b/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml index a3f8c937ec..5fe9c654dd 100644 --- a/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml +++ b/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml @@ -104,7 +104,7 @@ 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', - 'ALATM', 'ALONM', 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', + 'ALATM', 'ALONM', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC','FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 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..462280eb10 100644 --- a/cime_config/SystemTests/sct.py +++ b/cime_config/SystemTests/sct.py @@ -30,15 +30,17 @@ def __init__(self, case): def _case_one_setup(self): append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "inithist = 'CAMIOP'") + if self._case.get_value("CAM_DYCORE") == "se": + append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "scale_dry_air_mass = 0.0D0") CAM_CONFIG_OPTS = self._case1.get_value("CAM_CONFIG_OPTS") + self._case.set_value("BFBFLAG","TRUE") def _case_two_setup(self): case_name = self._case.get_value("CASE") RUN_STARTDATE = self._case1.get_value("RUN_STARTDATE") - append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "ncdata = '../"+case_name+".cam.i."+RUN_STARTDATE+"-00000.nc'") append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "NDENS = 1,1,1,1,1,1") append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "MFILT = 1,7,1,1,1,1") append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "nhtfrq = 1,1,1,1,1,1") @@ -47,6 +49,8 @@ def _case_two_setup(self): append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "inithist = 'YEARLY'") append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "scm_cambfb_mode = .true.") append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "scm_use_obs_uv = .true.") + append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "scm_relaxation = .false.") + append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "scm_use_3dfrc = .true.") for comp in self._case.get_values("COMP_CLASSES"): self._case.set_value("NTASKS_{}".format(comp), 1) self._case.set_value("NTHRDS_{}".format(comp), 1) @@ -54,18 +58,28 @@ def _case_two_setup(self): if self._case.get_value("COMP_INTERFACE") == "mct": self._case.set_value("PTS_MODE","TRUE") - self._case.set_value("PTS_LAT",-20.0) - self._case.set_value("PTS_LON",140.0) - CAM_CONFIG_OPTS = self._case1.get_value("CAM_CONFIG_OPTS") - self._case.set_value("CAM_CONFIG_OPTS","{} -scam ".format(CAM_CONFIG_OPTS)) + self._case.set_value("BFBFLAG","TRUE") + + CAM_CONFIG_OPTS = self._case1.get_value("CAM_CONFIG_OPTS").replace('-camiop','') + self._case.set_value("CAM_CONFIG_OPTS","{} -scam camfrc ".format(CAM_CONFIG_OPTS)) + if self._case.get_value("CAM_DYCORE") == "se": + self._case.set_value("PTS_LAT",44.80320177421346) + self._case.set_value("PTS_LON",276.7082039324993) + append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "scale_dry_air_mass = 0.0D0") + else: + append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "ncdata = '../"+case_name+".cam.i."+RUN_STARTDATE+"-00000.nc'") + self._case.set_value("PTS_LAT",-20.0) + self._case.set_value("PTS_LON",140.0) + + self._case.set_value("STOP_N",5) self._case.case_setup(test_mode=True, reset=True) def _component_compare_test(self, suffix1, suffix2, success_change=False, ignore_fieldlist_diffs=False): with self._test_status: - stat,netcdf_filename,err=run_cmd('ls ./run/case2run/*h1i*8400.nc ') + stat,netcdf_filename,err=run_cmd('ls ./run/case2run/*h1*0000.nc ') stat,DIFFs,err=run_cmd('ncdump -ff -p 9,17 -v QDIFF,TDIFF '+netcdf_filename+' | egrep //\.\*DIFF | sed s/^\ \*// | sed s/^0,/0.0,/ | sed s/^0\;/0.0\;/ | sed s/\[,\;\].\*// | uniq') array_of_DIFFs=DIFFs.split("\n") answer=max([abs(float(x)) for x in array_of_DIFFs]) @@ -79,3 +93,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..a5016f95f2 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, @@ -90,10 +81,6 @@ def buildcpp(case): if nlev: config_opts += ["-nlev", nlev] - # Some settings for single column mode. - if pts_mode: - config_opts.append("-scam") - if mpilib == 'mpi-serial': config_opts.append("-nospmd") else: @@ -136,7 +123,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..9c156b66d5 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,14 +75,14 @@ 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 + logger.warning(" ...cam buildcpp exited with error") # Verify that we have a config_cache file (generated by the call to buildcpp) expect(os.path.isfile(filename), - " Missing config_cache.xml - cannot run build-namelist") + " Missing CAM's config_cache.xml - cannot run build-namelist") #-------------------------------------------------------------------- # Invoke cam build-namelist - output will go in $CASEROOT/Buildconf/camconf @@ -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 9fbf740f6b..52eb8dd474 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -8,12 +8,11 @@ CAM =============== --> - CAM cam6 physics: - CAM cam5 physics: - CAM cam4 physics: - CAM cam3 physics: + CAM cam7 physics: + CAM cam6 physics: + CAM cam5 physics: + CAM cam4 physics: CAM simplified and non-versioned physics : - CAM7 development physics: - CAM stand-alone single column mode -- need to define usermods directory with IOP settings: + CAM stand-alone single column mode -- user defined IOP settings can be placed under the usermods scam_user directory: CAM specified dynamics is used in finite volume dynamical core: CAM physics is nudged towards prescribed meteorology: 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: @@ -130,22 +129,20 @@ - -phys cam3 -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 -rad camrt -chem none -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_sam1mom -spcam_clubb_sgs -rad rrtmg -chem trop_mam3 -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_m2005 @@ -175,8 +172,26 @@ -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 + + + -scam arm95 + -scam arm97 + -scam atex + -scam bomex + -scam cgilss11 + -scam cgilss12 + -scam cgilss6 + -scam dycomsrf01 + -scam dycomsrf02 + -scam gateIII + -scam mpace + -scam rico + -scam sparticus + -scam togaII + -scam twp06 + -scam camfrc -phys adiabatic @@ -218,14 +233,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 @@ -234,7 +249,6 @@ 2000_geoschem waccmx_ma_2000_cam6 - aquaplanet_cam3 aquaplanet_cam4 aquaplanet_cam4 aquaplanet_cam5 @@ -258,14 +272,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 @@ -304,9 +319,6 @@ dctest_tj2016 dctest_frierson dctest_baro_kessler - - - run_component_cam env_run.xml @@ -363,7 +375,8 @@ $COMP_ROOT_DIR_ATM/cime_config/usermods_dirs/aquap $COMP_ROOT_DIR_ATM/cime_config/usermods_dirs/aquap - $COMP_ROOT_DIR_ATM/cime_config/usermods_dirs/scam_mandatory + $COMP_ROOT_DIR_ATM/cime_config/usermods_dirs/scam_mandatory + $COMP_ROOT_DIR_ATM/cime_config/usermods_dirs/scam_camfrc run_component_cam env_case.xml diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index d2aec47d2e..8ba81de44a 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 @@ -121,8 +121,98 @@ - FSCAM - 2000_CAM60%SCAM_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + FSCAMARM95 + 2000_CAM60%FSCAMARM95_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMARM97 + 2000_CAM60%SCAMARM97_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMATEX + 2000_CAM60%SCAMATEX_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMBOMEX + 2000_CAM60%SCAMBOMEX_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMCGILSS11 + 2000_CAM60%SCAMCGILSS11_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMCGILSS12 + 2000_CAM60%SCAMCGILSS12_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMCGILSS6 + 2000_CAM60%SCAMCGILSS6_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMDYCOMSRF01 + 2000_CAM60%SCAMDYCOMSRF01_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMDYCOMSRF02 + 2000_CAM60%SCAMDYCOMSRF02_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMGATE3 + 2000_CAM60%SCAMGATE3_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMMPACE + 2000_CAM60%SCAMMPACE_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMRICO + 2000_CAM60%SCAMRICO_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMSPARTICUS + 2000_CAM60%SCAMSPARTICUS_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMTOGA2 + 2000_CAM60%SCAMTOGA2_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMTWP06 + 2000_CAM60%SCAMTWP06_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + + FSCAMCAMFRC + 2000_CAM60%SCAMCAMFRC_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV @@ -139,11 +229,6 @@ - - QPC3 - 2000_CAM30_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV - - QPC4 2000_CAM40_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV @@ -213,7 +298,7 @@ QPSCAMC5 - 2000_CAM50%SCAM_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV + 2000_CAM50%SCAMARM97_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV @@ -282,7 +367,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 +429,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 @@ -580,7 +669,6 @@ - 1997-06-18 1979-01-01 1950-01-01 2000-01-01 @@ -602,12 +690,70 @@ 2004-01-01 1950-01-01 + 1995-07-18 + 1997-06-18 + 1969-02-15 + 1969-06-25 + 1997-07-15 + 1997-07-15 + 1997-07-15 + 1999-07-11 + 1999-07-11 + 1974-08-30 + 2004-10-05 + 1995-07-15 + 2010-04-01 + 1992-12-18 + 2006-01-17 + 1997-06-18 + + + + + + 418 + 695 + 47 + 119 + 719 + 719 + 719 + 47 + 47 + 479 + 413 + 71 + 717 + 480 + 641 + 10 + + + + + + nhours - 84585 + 19800 + 84585 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 7171 + 0 + 3599 + 0 + 10800 + 0 @@ -713,13 +859,49 @@ - 36.6 + 36.6 + 36.6 + 15.0 + 15.0 + 32.0 + 35.0 + 17.0 + 31.5 + 31.5 + 9.0 + 70.5 + 18.0 + 36.6 + -2.1 + -12.43 + 36.6 - 262.5 + 262.5 + 262.5 + 345.0 + 300.0 + 231.0 + 235.0 + 211.0 + 238.5 + 238.5 + 336.0 + 206.0 + 298.5 + 262.51 + 154.69 + 130.89 + 262.5 + + + + + + FALSE diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml index 5b4bc10c5b..7b50ec52f3 100644 --- a/cime_config/config_pes.xml +++ b/cime_config/config_pes.xml @@ -1,42 +1,8 @@ - - - none - - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - - - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - - - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - - none @@ -109,6 +75,43 @@ + + + + none + + 24 + 24 + 24 + 24 + 24 + 24 + 24 + 24 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + @@ -432,7 +435,7 @@ 1 - + none -8 @@ -455,7 +458,7 @@ - + none -8 @@ -482,7 +485,7 @@ 0 - + none -12 @@ -540,7 +543,7 @@ - + none 1800 @@ -1790,14 +1793,14 @@ none - 128 - 128 - 128 - 128 - 128 - 128 - 128 - 128 + -3 + -3 + -3 + -3 + -3 + -3 + -3 + -3 1 @@ -2066,6 +2069,39 @@ 1 + + none + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 62cd0af626..2d736a2d51 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,26 +1156,38 @@ - + + + + + + + + + + + + - + + - + @@ -1180,9 +1197,10 @@ - + + @@ -1190,7 +1208,7 @@ - + @@ -1200,7 +1218,7 @@ - + @@ -1210,7 +1228,7 @@ - + @@ -1220,7 +1238,7 @@ - + @@ -1231,7 +1249,7 @@ - + @@ -1240,7 +1258,7 @@ - + @@ -1249,7 +1267,7 @@ - + @@ -1259,7 +1277,7 @@ - + @@ -1269,7 +1287,7 @@ - + @@ -1279,7 +1297,7 @@ - + @@ -1289,7 +1307,7 @@ - + @@ -1298,7 +1316,7 @@ - + @@ -1306,7 +1324,7 @@ - + @@ -1315,7 +1333,7 @@ - + @@ -1325,7 +1343,7 @@ - + @@ -1335,7 +1353,7 @@ - + @@ -1344,10 +1362,22 @@ + + + + + + + + + + - + + + @@ -1355,7 +1385,7 @@ - + @@ -1364,7 +1394,7 @@ - + @@ -1373,7 +1403,7 @@ - + @@ -1382,7 +1412,7 @@ - + @@ -1403,48 +1433,43 @@ - + - + - + - + - + - + - + - - - - - - + @@ -1455,21 +1480,23 @@ - + + - + + @@ -1479,127 +1506,87 @@ - + - - - + + - + - + - + + - - + - + - - + - + - + - - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - + - + + - + - - + - + - + - - + - - - - + - - + - - - - + @@ -1607,7 +1594,7 @@ - + @@ -1615,7 +1602,7 @@ - + @@ -1623,7 +1610,7 @@ - + @@ -1631,7 +1618,7 @@ - + @@ -1639,7 +1626,7 @@ - + @@ -1647,7 +1634,7 @@ - + @@ -1655,7 +1642,7 @@ - + @@ -1664,16 +1651,16 @@ - + - + - + @@ -1683,7 +1670,7 @@ - + @@ -1694,7 +1681,7 @@ - + @@ -1704,7 +1691,7 @@ - + @@ -1714,7 +1701,7 @@ - + @@ -1724,7 +1711,7 @@ - + @@ -1734,7 +1721,7 @@ - + @@ -1745,7 +1732,7 @@ - + @@ -1755,7 +1742,7 @@ - + @@ -1764,7 +1751,7 @@ - + @@ -1773,7 +1760,7 @@ - + @@ -1788,7 +1775,7 @@ - + @@ -1797,7 +1784,7 @@ - + @@ -1805,8 +1792,8 @@ - - + + @@ -1815,7 +1802,7 @@ - + @@ -1824,7 +1811,7 @@ - + @@ -1833,10 +1820,10 @@ - + - + @@ -1845,7 +1832,7 @@ - + @@ -1854,7 +1841,7 @@ - + @@ -1862,7 +1849,7 @@ - + @@ -1871,7 +1858,7 @@ - + @@ -1880,7 +1867,7 @@ - + @@ -1889,12 +1876,12 @@ - + - + @@ -1903,23 +1890,23 @@ - + - + - + - + @@ -1928,12 +1915,30 @@ - + + + + + + + + + + + + + + + + + + + - + @@ -1952,7 +1957,7 @@ - + @@ -1962,7 +1967,7 @@ - + @@ -1972,17 +1977,17 @@ - + - + - + @@ -1993,7 +1998,7 @@ - + @@ -2003,7 +2008,7 @@ - + @@ -2012,25 +2017,25 @@ - + - + - + - + @@ -2039,7 +2044,7 @@ - + @@ -2047,7 +2052,7 @@ - + @@ -2055,17 +2060,17 @@ - + - + - + @@ -2074,7 +2079,7 @@ - + @@ -2083,7 +2088,7 @@ - + @@ -2092,12 +2097,12 @@ - + - + @@ -2107,7 +2112,7 @@ - + @@ -2117,7 +2122,7 @@ - + @@ -2125,7 +2130,7 @@ - + @@ -2133,7 +2138,7 @@ - + @@ -2142,7 +2147,7 @@ - + @@ -2151,7 +2156,7 @@ - + @@ -2160,7 +2165,7 @@ - + @@ -2170,7 +2175,7 @@ - + @@ -2178,7 +2183,7 @@ - + @@ -2187,7 +2192,7 @@ - + @@ -2197,17 +2202,17 @@ - + - + - + @@ -2216,7 +2221,7 @@ - + @@ -2225,7 +2230,7 @@ - + @@ -2235,7 +2240,7 @@ - + @@ -2244,12 +2249,12 @@ - + - + @@ -2258,26 +2263,45 @@ - + - + + + + + + + + + + - + + + + + + + + + + + - + - + @@ -2287,7 +2311,7 @@ - + @@ -2296,7 +2320,7 @@ - + @@ -2305,7 +2329,7 @@ - + @@ -2314,7 +2338,7 @@ - + @@ -2323,7 +2347,7 @@ - + @@ -2331,7 +2355,7 @@ - + @@ -2339,7 +2363,7 @@ - + @@ -2347,7 +2371,7 @@ - + @@ -2355,7 +2379,7 @@ - + @@ -2364,12 +2388,12 @@ - + - + @@ -2378,7 +2402,7 @@ - + @@ -2387,7 +2411,7 @@ - + @@ -2395,15 +2419,15 @@ - + - + - + @@ -2412,7 +2436,7 @@ - + @@ -2420,7 +2444,7 @@ - + @@ -2429,59 +2453,69 @@ - + - + - + - + - + + + + + - + - + + + + + + + - + - + - + - + @@ -2490,12 +2524,12 @@ - + - + @@ -2503,7 +2537,7 @@ - + @@ -2511,22 +2545,22 @@ - + - + - + - + @@ -2534,7 +2568,7 @@ - + @@ -2542,7 +2576,7 @@ - + @@ -2550,7 +2584,7 @@ - + @@ -2559,7 +2593,7 @@ - + @@ -2567,7 +2601,7 @@ - + @@ -2575,32 +2609,32 @@ - + - + - + - + - + - + @@ -2610,7 +2644,7 @@ - + @@ -2618,7 +2652,7 @@ - + @@ -2627,7 +2661,7 @@ - + @@ -2635,7 +2669,7 @@ - + @@ -2644,7 +2678,7 @@ - + @@ -2652,7 +2686,7 @@ - + @@ -2661,22 +2695,22 @@ - + - + - + - + @@ -2685,17 +2719,17 @@ - + - + - + @@ -2704,7 +2738,7 @@ - + @@ -2713,12 +2747,12 @@ - + - + @@ -2727,7 +2761,7 @@ - + @@ -2737,7 +2771,7 @@ - + @@ -2746,13 +2780,13 @@ - + - + @@ -2761,17 +2795,17 @@ - + - + - + @@ -2785,11 +2819,11 @@ - + - + @@ -2797,13 +2831,13 @@ - + - + @@ -2813,7 +2847,7 @@ - + @@ -2823,7 +2857,7 @@ - + @@ -2833,7 +2867,7 @@ - + @@ -2843,7 +2877,7 @@ - + @@ -2852,13 +2886,13 @@ - + - + @@ -2867,7 +2901,7 @@ - + @@ -2887,20 +2921,20 @@ - + - + - + @@ -2914,7 +2948,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/outfrq1d_aoa/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/shell_commands new file mode 100644 index 0000000000..de6a2792a7 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange --append CAM_CONFIG_OPTS="-age_of_air_trcs" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_cam new file mode 100644 index 0000000000..b0d39d2335 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_cam @@ -0,0 +1,4 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=-24,-24,-24,-24,-24,-24 +write_nstep0 = .true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_clm similarity index 98% rename from cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/user_nl_clm rename to cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_clm index 12d5a36d2b..5634334558 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/user_nl_clm +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_clm @@ -21,6 +21,7 @@ ! Set maxpatch_glcmec with GLC_NEC option ! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable !---------------------------------------------------------------------------------- -hist_nhtfrq = 9 +hist_nhtfrq = -24 hist_mfilt = 1 hist_ndens = 1 + diff --git a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/shell_commands similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/shell_commands rename to cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/shell_commands diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/user_nl_cam new file mode 100644 index 0000000000..351fe92801 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/user_nl_cam @@ -0,0 +1,9 @@ +dust_emis_method = 'Leung_2023' + +fincl2 = 'dst_a1SF', 'dst_a2SF', 'dst_a3SF' + +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=9,9,9,9,9,9 +write_nstep0=.true. +inithist='ENDOFRUN' diff --git a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/user_nl_clm similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_clm rename to cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/user_nl_clm 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/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_mpasa480/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480/user_nl_cam index 8482082dce..ccffd8c129 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480/user_nl_cam @@ -2,3 +2,5 @@ mfilt=1,1,1,1,1,1 ndens=1,1,1,1,1,1 nhtfrq=9,9,9,9,9,9 inithist='ENDOFRUN' +mpas_cam_coef=1.0D0 +mpas_cam_damping_levels=3 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/scam_mpace_outfrq9s/include_user_mods b/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/include_user_mods deleted file mode 100644 index 4b0f7f1abb..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/include_user_mods +++ /dev/null @@ -1 +0,0 @@ -../../../../usermods_dirs/scam_mpace diff --git a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cam deleted file mode 100644 index 8482082dce..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cam +++ /dev/null @@ -1,4 +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' diff --git a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cpl deleted file mode 100644 index 398535cf65..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cpl +++ /dev/null @@ -1,2 +0,0 @@ -reprosum_diffmax=1.0e-14 -reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/scmarm/shell_commands b/cime_config/testdefs/testmods_dirs/cam/scmarm/shell_commands index 2898a75de3..3901f7a7b0 100644 --- a/cime_config/testdefs/testmods_dirs/cam/scmarm/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/scmarm/shell_commands @@ -1,4 +1,3 @@ -./xmlchange -append CAM_CONFIG_OPTS="-scam" ./xmlchange ROF_NCPL=\$ATM_NCPL ./xmlchange GLC_NCPL=\$ATM_NCPL ./xmlchange EPS_AAREA=9.0e-4 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_SAS/shell_commands b/cime_config/usermods_dirs/scam_SAS/shell_commands deleted file mode 100755 index 17c5081867..0000000000 --- a/cime_config/usermods_dirs/scam_SAS/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=272.85 -./xmlchange PTS_LAT=32.5 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=2013-06-10 -./xmlchange START_TOD=43200 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=30 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_SAS/user_nl_cam b/cime_config/usermods_dirs/scam_SAS/user_nl_cam deleted file mode 100644 index 9a5a9304d7..0000000000 --- a/cime_config/usermods_dirs/scam_SAS/user_nl_cam +++ /dev/null @@ -1,17 +0,0 @@ -use_gw_front = .false. -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/SAS_ideal_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-06-01-00000.nc" -mfilt=30 -nhtfrq=1 -co2vmr=368.9e-6 -scm_use_obs_uv = .true. -scm_backfill_iop_w_init = .true. -scm_relaxation = .true. -scm_relax_fincl = 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_arm95/shell_commands b/cime_config/usermods_dirs/scam_arm95/shell_commands deleted file mode 100755 index e902f2be49..0000000000 --- a/cime_config/usermods_dirs/scam_arm95/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=262.5 -./xmlchange PTS_LAT=36.6 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1995-07-18 -./xmlchange START_TOD=19800 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=1259 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_arm95/user_nl_cam b/cime_config/usermods_dirs/scam_arm95/user_nl_cam deleted file mode 100644 index 591b415e0d..0000000000 --- a/cime_config/usermods_dirs/scam_arm95/user_nl_cam +++ /dev/null @@ -1,15 +0,0 @@ -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-07-01-00000.nc" -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/ARM95_4scam.nc" -mfilt=1500 -nhtfrq=1 -co2vmr=368.9e-6 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_arm97/shell_commands b/cime_config/usermods_dirs/scam_arm97/shell_commands deleted file mode 100755 index a695db6d58..0000000000 --- a/cime_config/usermods_dirs/scam_arm97/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=262.5 -./xmlchange PTS_LAT=36.6 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1997-06-18 -./xmlchange START_TOD=84585 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=2088 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_arm97/user_nl_cam b/cime_config/usermods_dirs/scam_arm97/user_nl_cam deleted file mode 100644 index 3327b2c69a..0000000000 --- a/cime_config/usermods_dirs/scam_arm97/user_nl_cam +++ /dev/null @@ -1,15 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/ARM97_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-06-01-00000.nc" -mfilt=2088 -nhtfrq=1 -co2vmr=368.9e-6 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_atex/shell_commands b/cime_config/usermods_dirs/scam_atex/shell_commands deleted file mode 100755 index cea0583b9b..0000000000 --- a/cime_config/usermods_dirs/scam_atex/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=345. -./xmlchange PTS_LAT=15. - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1969-02-15 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=ndays -./xmlchange STOP_N=2 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_atex/user_nl_cam b/cime_config/usermods_dirs/scam_atex/user_nl_cam deleted file mode 100644 index d658f99157..0000000000 --- a/cime_config/usermods_dirs/scam_atex/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/ATEX_48hr_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-02-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_bomex/user_nl_cam b/cime_config/usermods_dirs/scam_bomex/user_nl_cam deleted file mode 100644 index e9132902b8..0000000000 --- a/cime_config/usermods_dirs/scam_bomex/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/BOMEX_5day_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-06-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_bomex/shell_commands b/cime_config/usermods_dirs/scam_camfrc/shell_commands similarity index 79% rename from cime_config/usermods_dirs/scam_bomex/shell_commands rename to cime_config/usermods_dirs/scam_camfrc/shell_commands index 6d2bb04886..b12fe28bb0 100755 --- a/cime_config/usermods_dirs/scam_bomex/shell_commands +++ b/cime_config/usermods_dirs/scam_camfrc/shell_commands @@ -1,15 +1,15 @@ # setup SCAM lon and lat for this iop # this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=300. -./xmlchange PTS_LAT=15. +./xmlchange PTS_LON=276.7082039324993 +./xmlchange PTS_LAT=44.80320177421346 # Specify the starting/ending time for the IOP # The complete time slice of IOP file is specified below # but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1969-06-25 +./xmlchange RUN_STARTDATE=1997-01-01 ./xmlchange START_TOD=0 ./xmlchange STOP_OPTION=ndays -./xmlchange STOP_N=5 +./xmlchange STOP_N=1 # usermods_dir/scam_mandatory will be included for all single column # runs by default. This usermods directory contains mandatory settings diff --git a/cime_config/usermods_dirs/scam_camfrc/user_nl_cam b/cime_config/usermods_dirs/scam_camfrc/user_nl_cam new file mode 100644 index 0000000000..1dc04efa8e --- /dev/null +++ b/cime_config/usermods_dirs/scam_camfrc/user_nl_cam @@ -0,0 +1,10 @@ +mfilt=2088 +nhtfrq=1 +co2vmr=368.9e-6 +scm_use_obs_uv = .true. +scm_relaxation = .false. +scm_relax_bot_p = 105000. +scm_relax_top_p = 200. +scm_relax_linear = .true. +scm_relax_tau_bot_sec = 864000. +scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_cgilsS11/shell_commands b/cime_config/usermods_dirs/scam_cgilsS11/shell_commands deleted file mode 100755 index 37056ed761..0000000000 --- a/cime_config/usermods_dirs/scam_cgilsS11/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=231. -./xmlchange PTS_LAT=32. - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1997-07-15 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=ndays -./xmlchange STOP_N=30 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_cgilsS11/user_nl_cam b/cime_config/usermods_dirs/scam_cgilsS11/user_nl_cam deleted file mode 100644 index c58ac57499..0000000000 --- a/cime_config/usermods_dirs/scam_cgilsS11/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/S11_CTL_MixedLayerInit_reduced.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-07-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_cgilsS12/shell_commands b/cime_config/usermods_dirs/scam_cgilsS12/shell_commands deleted file mode 100755 index fefce8216e..0000000000 --- a/cime_config/usermods_dirs/scam_cgilsS12/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=235. -./xmlchange PTS_LAT=35. - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1997-07-15 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=ndays -./xmlchange STOP_N=30 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_cgilsS12/user_nl_cam b/cime_config/usermods_dirs/scam_cgilsS12/user_nl_cam deleted file mode 100644 index 52e9e20093..0000000000 --- a/cime_config/usermods_dirs/scam_cgilsS12/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/S12_CTL_MixedLayerInit_reduced.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-07-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_cgilsS6/shell_commands b/cime_config/usermods_dirs/scam_cgilsS6/shell_commands deleted file mode 100755 index 5ecc09e2a4..0000000000 --- a/cime_config/usermods_dirs/scam_cgilsS6/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=211. -./xmlchange PTS_LAT=17. - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1997-07-15 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=ndays -./xmlchange STOP_N=30 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_cgilsS6/user_nl_cam b/cime_config/usermods_dirs/scam_cgilsS6/user_nl_cam deleted file mode 100644 index 6b2a0222f4..0000000000 --- a/cime_config/usermods_dirs/scam_cgilsS6/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/S6_CTL_reduced.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-07-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_dycomsRF01/shell_commands b/cime_config/usermods_dirs/scam_dycomsRF01/shell_commands deleted file mode 100755 index 241e785227..0000000000 --- a/cime_config/usermods_dirs/scam_dycomsRF01/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=238.5 -./xmlchange PTS_LAT=31.5 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1999-07-11 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=144 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_dycomsRF01/user_nl_cam b/cime_config/usermods_dirs/scam_dycomsRF01/user_nl_cam deleted file mode 100644 index 76a2c10c55..0000000000 --- a/cime_config/usermods_dirs/scam_dycomsRF01/user_nl_cam +++ /dev/null @@ -1,15 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/DYCOMSrf01_4day_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-07-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_use_obs_T =.true. -scm_relaxation = .true. -scm_relax_fincl = 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_dycomsRF02/shell_commands b/cime_config/usermods_dirs/scam_dycomsRF02/shell_commands deleted file mode 100755 index 241e785227..0000000000 --- a/cime_config/usermods_dirs/scam_dycomsRF02/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=238.5 -./xmlchange PTS_LAT=31.5 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1999-07-11 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=144 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_dycomsRF02/user_nl_cam b/cime_config/usermods_dirs/scam_dycomsRF02/user_nl_cam deleted file mode 100644 index 57ebe708ed..0000000000 --- a/cime_config/usermods_dirs/scam_dycomsRF02/user_nl_cam +++ /dev/null @@ -1,15 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/DYCOMSrf02_48hr_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-07-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_use_obs_T =.true. -scm_relaxation = .true. -scm_relax_fincl = 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_gateIII/shell_commands b/cime_config/usermods_dirs/scam_gateIII/shell_commands deleted file mode 100755 index 03642e292a..0000000000 --- a/cime_config/usermods_dirs/scam_gateIII/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=336.0 -./xmlchange PTS_LAT=9.00 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1974-08-30 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=1440 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_gateIII/user_nl_cam b/cime_config/usermods_dirs/scam_gateIII/user_nl_cam deleted file mode 100644 index 96e7b2ddbc..0000000000 --- a/cime_config/usermods_dirs/scam_gateIII/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/GATEIII_4scam_c170809.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-08-01-00000.nc" -mfilt=1440 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. 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/cime_config/usermods_dirs/scam_micre2017/shell_commands b/cime_config/usermods_dirs/scam_micre2017/shell_commands deleted file mode 100755 index b7b2225466..0000000000 --- a/cime_config/usermods_dirs/scam_micre2017/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON= 141.5 -./xmlchange PTS_LAT= -56.0 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=2017-01-01 -./xmlchange START_TOD=0000 -./xmlchange STOP_OPTION=ndays -./xmlchange STOP_N=90 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_micre2017/user_nl_cam b/cime_config/usermods_dirs/scam_micre2017/user_nl_cam deleted file mode 100644 index 675974b5e7..0000000000 --- a/cime_config/usermods_dirs/scam_micre2017/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile='$DIN_LOC_ROOT/atm/cam/scam/iop/micre2017_3mo.macquarie2017.iop.nc' -ncdata ='$DIN_LOC_ROOT/atm/cam/scam/iop/micre2017_3mo.cam.i.2017-01-01-00000.regrid.Gaus_64x128.nc' -mfilt=9000 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_mpace/shell_commands b/cime_config/usermods_dirs/scam_mpace/shell_commands deleted file mode 100755 index d9d0e50837..0000000000 --- a/cime_config/usermods_dirs/scam_mpace/shell_commands +++ /dev/null @@ -1,17 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=206.0 -./xmlchange PTS_LAT=70.5 - - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=2004-10-05 -./xmlchange START_TOD=7171 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=1242 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_mpace/user_nl_cam b/cime_config/usermods_dirs/scam_mpace/user_nl_cam deleted file mode 100644 index cb3263e871..0000000000 --- a/cime_config/usermods_dirs/scam_mpace/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/MPACE_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-10-01-00000.nc" -mfilt=1242 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_rico/shell_commands b/cime_config/usermods_dirs/scam_rico/shell_commands deleted file mode 100755 index ad424f951b..0000000000 --- a/cime_config/usermods_dirs/scam_rico/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=298.5 -./xmlchange PTS_LAT=18. - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1995-07-15 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=216 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_rico/user_nl_cam b/cime_config/usermods_dirs/scam_rico/user_nl_cam deleted file mode 100644 index 968b1e3c71..0000000000 --- a/cime_config/usermods_dirs/scam_rico/user_nl_cam +++ /dev/null @@ -1,15 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/RICO_3day_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-07-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_use_obs_T =.true. -scm_relaxation = .true. -scm_relax_fincl = 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_sparticus/shell_commands b/cime_config/usermods_dirs/scam_sparticus/shell_commands deleted file mode 100755 index 68dbd4467c..0000000000 --- a/cime_config/usermods_dirs/scam_sparticus/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=262.51 -./xmlchange PTS_LAT=36.6 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=2010-04-01 -./xmlchange START_TOD=3599 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=2156 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_sparticus/user_nl_cam b/cime_config/usermods_dirs/scam_sparticus/user_nl_cam deleted file mode 100644 index d12c7a3609..0000000000 --- a/cime_config/usermods_dirs/scam_sparticus/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/SPARTICUS_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-04-01-00000.nc" -mfilt=2156 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_togaII/shell_commands b/cime_config/usermods_dirs/scam_togaII/shell_commands deleted file mode 100755 index 6ab21646b1..0000000000 --- a/cime_config/usermods_dirs/scam_togaII/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=154.69 -./xmlchange PTS_LAT=-2.10 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1992-12-18 -./xmlchange START_TOD=64800 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=1512 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_togaII/user_nl_cam b/cime_config/usermods_dirs/scam_togaII/user_nl_cam deleted file mode 100644 index f6a36ad6eb..0000000000 --- a/cime_config/usermods_dirs/scam_togaII/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/TOGAII_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-12-01-00000.nc" -mfilt=9 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_twp06/shell_commands b/cime_config/usermods_dirs/scam_twp06/shell_commands deleted file mode 100755 index 7787ba2453..0000000000 --- a/cime_config/usermods_dirs/scam_twp06/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=130.89 -./xmlchange PTS_LAT=-12.32 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=2006-01-17 -./xmlchange START_TOD=10800 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=1926 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_twp06/user_nl_cam b/cime_config/usermods_dirs/scam_twp06/user_nl_cam deleted file mode 100644 index 565a384502..0000000000 --- a/cime_config/usermods_dirs/scam_twp06/user_nl_cam +++ /dev/null @@ -1,16 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/TWP06_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-01-01-00000.nc" -mfilt=1926 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. -iradlw = 1 -iradsw = 1 diff --git a/components/cdeps b/components/cdeps new file mode 160000 index 0000000000..7b0b3a8272 --- /dev/null +++ b/components/cdeps @@ -0,0 +1 @@ +Subproject commit 7b0b3a827241c53d296ec877cb1f59966bf5e5bf diff --git a/components/cice b/components/cice new file mode 160000 index 0000000000..f14ec8339b --- /dev/null +++ b/components/cice @@ -0,0 +1 @@ +Subproject commit f14ec8339bc5bc4a7a0664da5e247b5cfda531a1 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..0999a32f52 --- /dev/null +++ b/components/clm @@ -0,0 +1 @@ +Subproject commit 0999a32f520c995c3dfc94b9b96781d20ed0d6d5 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 5ea328d2c8..1f35e8621b 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,5749 @@ =============================================================== +Tag name: cam6_4_033 +Originator(s): gdicker1 (gdicker@ucar.edu) +Date: Tue 10 Sep 2024 +One-line Summary: Add updated meshes and topo for v8 MPAS-A dycore +Github PR URL: https://github.com/ESCOMP/CAM/pull/1029 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +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 + +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: adamrher, jtruesdal, cacraigucar, mgduda + +List all files eliminated: + +- mpasa120_L32_topo_coords_c201022.nc + +Eliminated, replaced by newer versions: +- mpasa480_L32_notopo_coords_c201125.nc +- mpasa120_L32_notopo_coords_c201216.nc +- mpasa60_L32_notopo_coords_c230707.nc +- mpasa30_L32_notopo_coords_c230707.nc +- mpasa120km.waccm_fulltopo_c220818.nc +- cami_01_01_2000_00Z_mpasa120_L32_CFSR_c210426.nc +- cami_01_01_2000_00Z_mpasa480_L32_CFSR_c211013.nc +- mpas_120_nc3000_Co060_Fi001_MulG_PF_Nsw042_c200921.nc +- mpas_480_nc3000_Co240_Fi001_MulG_PF_Nsw170.nc + +List all files added and what they do: + +New input 32, 58, and 93L without real-data (analytic-ICs only): +- mpasa480_L32_notopo_coords_c240507.nc +- mpasa120_L32_notopo_coords_c240507.nc +- mpasa60_L32_notopo_coords_c240507.nc +- mpasa30_L32_notopo_coords_c240507.nc +- mpasa480_L58_notopo_coords_c240814.nc +- mpasa120_L58_notopo_coords_c240814.nc +- mpasa60_L58_notopo_coords_c240814.nc +- mpasa480_L93_notopo_coords_c240814.nc +- mpasa120_L93_notopo_coords_c240814.nc +- mpasa60_L93_notopo_coords_c240814.nc + +New input L70 file for waccm cases: +- mpasa120_L70.waccm_topography_SC_c240904.nc + +New input data with topology and real-data ICs: +- cami_01-01-2000_00Z_mpasa480_L32_CFSR_c240508.nc +- cami_01-01-2000_00Z_mpasa120_L32_CFSR_c240508.nc +- cami_01-01-2000_00Z_mpasa480_L58_CFSR_c240814.nc +- cami_01-01-2000_00Z_mpasa120_L58_CFSR_c240814.nc +- cami_01-01-2000_00Z_mpasa480_L93_CFSR_c240814.nc +- cami_01-01-2000_00Z_mpasa120_L93_CFSR_c240814.nc + +New bnd_topo files: +- mpasa480_gmted2010_modis_bedmachine_nc3000_Laplace0400_noleak_20240507.nc +- mpasa120_gmted2010_modis_bedmachine_nc3000_Laplace0100_noleak_20240507.nc + +List all existing files that have been modified, and describe the changes: +M bld/namelist_files/namelist_defaults_cam.xml + - Add new ncdata and bnd_topo files above so they can be used +M src/dynamics/mpas/dyn_grid.F90 + - Modifies setup_time_invariant to ensure lonCell values are in [0,2pi) range + +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.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) + - pre-existing failure -- need fix in CLM external + + 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) + - expected fails of BASELINE and NLCOMP steps, new mpas input data + +derecho/nvhpc/aux_cam: ALL PASS + +izumi/nag/aux_cam: + + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + + ERC_D_Ln9.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) + - expected fails of BASELINE and NLCOMP steps, new mpas input data + +izumi/gnu/aux_cam: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +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): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam6_4_032 +Originator(s): eaton +Date: +One-line Summary: Use same cloud water for radiation and COSP. +Github PR URL: https://github.com/ESCOMP/CAM/pull/1084 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Issue #1027 - Radiatively active cloud water missing from COSP. + +The all-cloud liquid and ice mixing ratios calculated in the conv_water module are +used by the radiation code. Use these same quantities in the COSP code by +making them accessable via the physics buffer. + +resolves #1027 + +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: 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_snapshot_common.F90 +. remove pbuf fields DP_CLDLIQ, DP_CLDICE, SH_CLDLIQ1, SH_CLDICE1 + +src/physics/cam/conv_water.F90 +. add GB_TOTCLDLIQMR, GB_TOTCLDICEMR to pbuf +. remove SH_CLDLIQ1, SH_CLDICE1 from pbuf +. conv_water_4rad + - remove dummy args totg_liq and totg_ice and replace assignment to those + args by assignment to the pbuf variables GB_TOTCLDLIQMR and + GB_TOTCLDICEMR + +src/physics/cam/cloud_diagnostics.F90 +. access the pbuf fields GB_TOTCLDLIQMR and GB_TOTCLDICEMR which are set by + the calls to conv_water_4rad + +src/physics/cam/cospsimulator_intr.F90 +. replace access of pbuf fields DP_CLDLIQ, DP_CLDICE, SH_CLDLIQ1, and + SH_CLDICE1, by GB_TOTCLDLIQMR and GB_TOTCLDICEMR +. assign the total cloud mixing ratios to the arguments for the large scale + values, and set the convective cloud inputs to zero. + +src/physics/cam/zm_conv_intr.F90 +. remove pbuf fields DP_CLDLIQ and DP_CLDICE which were set to 0. and being + used as if they had real data by COSP. + +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.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) + - pre-existing failure -- need fix in CLM external + + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PASS) + - test failed with error in ESMF on first run, but passed when I reran the tests + - unclear when/why exactly this test began to pass again + + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: All BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB. Only COSP diagnostic fields have +differences. + +=============================================================== + +Tag name: cam6_4_031 +Originator(s): jedwards, eaton +Date: Sept 9, 2024 +One-line Summary: fix issues #1108, #1106, #1058, #1051, #1050; merge PR#1101 +Github PR URL: https://github.com/ESCOMP/CAM/pull/1131 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Issue #1108 - More robust logic in gw_drag.F90 when deep_scheme='off' +- Modify build-namelist to set use_gw_convect_dp=.false. when + deep_scheme='off'. In gw_drag::gw_tend check whether field TTEND_DP is + in the pbuf. If so then associate the ttend_dp pointer. If not then + allocate the ttend_dp pointer and set to zero. + +PR #1101 - improved fix for rh write performance +- reorder output fields. Merge Jim's PR into this one. + +Issue #1106 - Report an error if a user uses --model_top with anything other than cam7 +- configure reports this error, but the output in the log file gets + obscured by a stack traceback issued from buildnml which is not useful. + The fix implemented in buildnml replaces the "raise RuntimeError" call with + a warning message in the log file. Then, if a subsequent check for CAM's + config_cache.xml file fails, the execution is terminated by a call to + the CIME.utils "expect()" routine. + +Issue #1058 - Remove unused pbuf variable smaw +- Remove both smaw and turbtype from physics buffer. Neither is used. + Remove the calculation of smaw entirely. Calculation of turbtype + remains. It is used locally, and may be written to history file + (UW_turbtype). + +Issue #1051 - Bad logic in SE dycore "interpolate_vector" subroutines +- These subroutines are not currently used by CAM as they are restricted to + interpolating fields on the GLL grid. Fix the conditional logic and + update the endrun message. + +Issue #1050 - Remove CAM3 as a compset or configure option + +Describe any changes made to build system: + +Describe any changes made to the namelist: +. build-namelist now sets use_gw_convect_dp=.false. when deep_scheme='off'. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: peverwhee, nusbaume + +List all files eliminated: + +bld/namelist_files/use_cases/aquaplanet_cam3.xml +src/physics/cam/cam3_aero_data.F90 +src/physics/cam/cam3_ozone_data.F90 + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +bld/build-namelist +. add check to set use_gw_convect_dp=.false. when deep_scheme='off'. +. remove cam3 conditionals +. remove variables cam3_ozone_data_on, cam3_aero_data_on, bndtvo, bndtvaer +. remove cam3 ozone and aerosols from rad_climate specification. +. remove cam3 aerosol deposition fluxes +. remove add_default for fcrit2 + +bld/configure +. remove cam3 as valid physics package + +bld/config_files/definition.xml +. remove cam3 as valid value for -phys + +bld/namelist_files/namelist_defaults_cam.xml +. remove cam3 bulk aerosol files +. remove cam3 setting for fv_fft_flt + +bld/namelist_files/namelist_definition.xml +. remove definitions for cam3_ozone_data_on, cam3_aero_data_on, bndtvo, + bndtvaer, ozncyc +. remove cam3 as valid value for cam_physpkg +. remove definition for fcrit2 + +cime_config/buildnml +. replace RuntimeError exception with message to logger. + +cime_config/config_compsets.xml +. remove QPC3 + +cime_config/config_component.xml +. remove regexp matches for _CAM30 + +src/chemistry/modal_aero/modal_aero_rename.F90 +. remove cam3 comments + +src/chemistry/utils/prescribed_ozone.F90 +. remove cam3 conditional + +src/control/cam_history.F90 +. The variables in the restart history files are reordered so that the nacs + variables are all written together rather than being next to their + corresponding fields. + +src/control/cam_snapshot_common.F90 +. change npbuf_all from 327 to 314 +. fill_pbuf_info + - remove smaw, turbtype + - remove 11 fields: cam3_* + +src/control/runtime_opts.F90 +. remove refs to cam3_aero_data and cam3_ozone_data + +src/dynamics/fv/cd_core.F90 +src/dynamics/fv/dynamics_vars.F90 +. remove cam3 comments + +src/dynamics/se/dycore/interpolate_mod.F90 +. interpolate_vector2d and interpolate_vector3d + - fix conditional logic and clarify endrun message to indicate that the + input fields must be on the GLL grid. + +src/physics/cam/convect_shallow.F90 +. remove cam3 from conditional + +src/physics/cam/eddy_diff.F90 +. caleddy + - remove intent(out) arg sm_aw + +src/physics/cam/eddy_diff_cam.F90 +. eddy_diff_tend + - remove intent(out) args sm_aw and turbtype +. compute_eddy_diff + - remove intent(out) arg sm_aw + - remove intent(out) arg turbtype. use local storage for turbtype. + +src/physics/cam/gw_common.F90 +. remove cam3 comment + +src/physics/cam/gw_drag.F90 +. check that field TTEND_DP is in the pbuf before trying to associate the + pointer ttend_dp. If TTEND_DP is not in pbuf then allocate the ttend_dp + pointer and fill with zeros. +. remove fcrit2 from the namelist. Hardcode to 1.0 in GWBand call that + sets band_oro, just like all the other calls to GWBand. + +src/physics/cam/rk_stratiform.F90 +. remove cam3 from conditional + +src/physics/cam/uwshcu.F90 +. remove cam3 comment + +src/physics/cam/vertical_diffusion.F90 +. remove smaw and turbtype from physics buffer +. vertical_diffusion_tend + - remove smaw and turbtype as actual args in call to eddy_diff_tend + +src/physics/cam/zm_conv_intr.F90 +. remove cam3 conditional + +src/physics/camrt/radlw.F90 +. remove cam3 conditional + +src/physics/rrtmg/aer_src/rrtmg_sw_init.f90 +. remove cam3 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: + + 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 + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) + - pre-existing failures -- need fix in CLM external + +derecho/nvhpc/aux_cam: ALL PASS + +izumi/nag/aux_cam: + + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - 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 + +=============================================================== +=============================================================== + +Tag name: cam6_4_030 +Originator(s): eaton, cacraig +Date: Sept 6, 2024 +One-line Summary: fix psl values sent to coupler in cam7 +Github PR URL: https://github.com/ESCOMP/CAM/pull/1128 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +. Fix issue #1116 - Test SMS_Ld2.ne30pg3_t232.BMT1850.derecho_gnu.allactive-defaultio Fails + - The cam7 version of tphysbc has a call to cpslec added in front of the + call to cam_export so that psl is set consistent with the state sent to + the coupler. + +. Fix issue #805 - cplsec.F90 needs to be in a module. + - Add subroutine cpslec to a new module, src/utils/cam_diagnostic_utils.F90 + +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: + +src/physics/cam/cpslec.F90 +. subroutine cpslec moved to new module + +List all files added and what they do: + +src/utils/cam_diagnostic_utils.F90 +. subroutine cpslec added to this new module + +List all existing files that have been modified, and describe the changes: + +src/physics/cam/cam_diagnostics.F90 +. add access to cpslec from cam_diagnostic_utils module + +src/physics/cam7/physpkg.F90 +. add calculation of psl to tphysbc right in front of call to cam_export + +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 SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s RUN time=77 + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + 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 + + 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.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq1d_aoa (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_Leung_dust (Overall: DIFF) details: + - CPL history file has difference in the atmImp_Sa_pslv field for CAM7 runs + +derecho/nvhpc/aux_cam: + ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default (Overall: DIFF) details: + - CPL history file has difference in the atmImp_Sa_pslv field for CAM7 runs + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB in F compsets. Answers will change + in B compsets. + +=============================================================== +=============================================================== + +Tag name: cam6_4_029 +Originator(s): fvitt +Date: 5 Sep 2024 +One-line Summary: Updates to age of air diagnostic tracers +Github PR URL: https://github.com/ESCOMP/CAM/pull/1110 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + New age of air tracer (issue #1082): + Implement an age of air diagnostic tracer (AOA1MF) which has a mixing ratio lower + boundary condition which increases 2% per year starting from 1.e-6. Initial mass mixing + ratios. Legacy age of air tracers AOA1 and AOA2 are removed. + + Update upper boundary file in CAM LT use case for simulations that begin in 1850. + +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 cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_clm + - for testing age-of-air tracers + +List all existing files that have been modified, and describe the changes: +M bld/configure + - change number of advected AOA tracers to 3 + +M bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml +M bld/namelist_files/use_cases/sd_waccm_ma_cam4.xml +M bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml +M bld/namelist_files/use_cases/sd_waccm_sulfur.xml +M bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +M bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml +M bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml +M bld/namelist_files/use_cases/soa_chem_megan_emis.xml +M bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml +M bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml +M bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml +M bld/namelist_files/use_cases/waccm_ma_hist_cam4.xml +M bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_1850_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_2000_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_2010_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml +M bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml +M bld/namelist_files/use_cases/waccmx_ma_2000_cam6.xml +M bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml +M bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml + - remove obsolete AOA tracer fields from fincl lists + +M bld/namelist_files/use_cases/hist_cam_lt.xml + - update UBC file for runs that start in 1850 + +M cime_config/testdefs/testlist_cam.xml + - add new TS4-cam7-MT AOA test + +M src/physics/cam/aoa_tracers.F90 + - implement new AOAMF tracer (described above) + - remove obsolete AOA1 and AOA2 tracers + +M src/physics/cam/physpkg.F90 +M src/physics/cam7/physpkg.F90 + - aoa_tracers_timestep_tend interface change + +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 SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + 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 + + NLFAIL ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s + NLFAIL ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp + - change in ubc_file_path, otherwise bit-for-bit + + DIFF ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s + DIFF ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d + DIFF ERP_Ld3.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq1d_aoa + DIFF ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h + 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_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s + 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.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.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s + 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_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s + DIFF SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp + - expect baseline failures -- differences in age-of-air tracers + otherwise bit-for-bit + +derecho/nvhpc/aux_cam: PASS + +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.QPWmaC6.izumi_nag.cam-outfrq3s + DIFF SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s + DIFF SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem + - expect baseline failures -- differences in age-of-air tracers + otherwise bit-for-bit + +izumi/gnu/aux_cam: + DIFF SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee + DIFF SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s + - expect baseline failures -- differences in age-of-air tracers + otherwise bit-for-bit + +Summarize any changes to answers: bit-for-bit + +=============================================================== +=============================================================== + +Tag name: cam6_4_028 +Originator(s): fvitt +Date: 4 Sep 2024 +One-line Summary: Add capability to use Leung dust emission scheme +Github PR URL: https://github.com/ESCOMP/CAM/pull/1104 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Add the capability to use Leung_2023 land model dust emission scheme. + Zender_2003 is the default scheme for all F compsets. + (issues #141 and #654) + + NOTE: This reverts cam7 compsets back to Zender_2003 dust emissions. + In tag cam6_4_027 cam7 compsets dust emissions scheme defaulted to + Leung_2023 and where not properly scaled. + +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: ekluzek, cacraigucar + +List all files eliminated: N/A + +List all files added and what they do: +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/user_nl_clm + - add test for Leung_2023 dust emis scheme + +List all existing files that have been modified, and describe the changes: +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cam.xml + - set default dust emis namelist settings (Zender_2003 is the default scheme) + +M bld/namelist_files/namelist_definition.xml + - new dust emis namelist vars: + . dust_emis_method ('Zender_2003' or 'Leung_2023') + . zend_soil_erod_source ('atm' or 'lnd') + +M cime_config/config_compsets.xml + - override the 'LND_SETS_DUST_EMIS_DRV_FLDS' xml setting to be FALSE for cam7/clm6 F compsets + +M cime_config/testdefs/testlist_cam.xml + - increase time for aux_cam HEMCO test + - regression test Leung_2023 dust emis scheme + +M src/chemistry/bulk_aero/dust_model.F90 +M src/chemistry/modal_aero/dust_model.F90 + - use soil_erod only if Zender scheme is used + +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 SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + 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 + + 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 SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s + - differences due to switching dust emis scheme from Leung_2023 to Zender_2003 + + DIFF SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s_Leung_dust + - new reg test -- no baseline to compare against + + NLFAIL ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp + NLFAIL ERC_D_Ln9.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s + NLFAIL ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s + NLFAIL ERC_D_Ln9.ne16_ne16_mg17.FADIAB.derecho_intel.cam-terminator + NLFAIL ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase + NLFAIL ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase + NLFAIL ERC_D_Ln9.T42_T42_mg17.FDABIP04.derecho_intel.cam-outfrq3s_usecase + NLFAIL ERC_D_Ln9.T42_T42_mg17.FHS94.derecho_intel.cam-outfrq3s_usecase + NLFAIL ERI_D_Ln18.f45_f45_mg37.QPC41850.derecho_intel.cam-co2rmp_usecase + NLFAIL ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s + NLFAIL ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s + NLFAIL ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes + NLFAIL ERS_Ln9.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s + NLFAIL ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.derecho_intel.cam-outfrq3s_refined + NLFAIL SCT_D_Ln7.ne3_ne3_mg37.QPC5.derecho_intel.cam-scm_prep + NLFAIL SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep + NLFAIL SMS_D_Ld2.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase + NLFAIL SMS_D_Ld5.f19_f19_mg17.PC4.derecho_intel.cam-cam4_port5d + NLFAIL SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase + NLFAIL SMS_D_Ln9.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s + NLFAIL SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s + NLFAIL SMS_Ld5.f09_f09_mg17.PC6.derecho_intel.cam-cam6_port_f09 + NLFAIL SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem + - namelist compare failures due to dust_emis_inparm namelist in drv_flds_in + otherwise bit-for-bit + +derecho/nvhpc/aux_cam: + DIFF ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default + - difference due to switching dust emis scheme from Leung_2023 to Zender_2003 + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s + NLFAIL ERC_D_Ln9.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s + NLFAIL ERC_D_Ln9.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase + NLFAIL ERC_D_Ln9.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase + NLFAIL ERC_D_Ln9.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase + NLFAIL ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac + NLFAIL ERC_D_Ln9.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase + NLFAIL ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac + NLFAIL ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 + NLFAIL ERI_D_Ln18.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic + NLFAIL ERI_D_Ln18.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic + NLFAIL ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf + NLFAIL ERS_Ln27.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s + NLFAIL ERS_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s + NLFAIL PEM_D_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s + NLFAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 + NLFAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 + NLFAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 + NLFAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 + NLFAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 + NLFAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 + NLFAIL SMS_D_Ld2.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port + NLFAIL SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s + NLFAIL SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem + NLFAIL SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm + NLFAIL SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam + NLFAIL SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba + NLFAIL SMS_D_Ln9_P1x1.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s + NLFAIL SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase + NLFAIL SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s + NLFAIL TMC_D.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac + NLFAIL TMC_D.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 + - namelist compare failures due to dust_emis_inparm namelist in drv_flds_in + otherwise bit-for-bit + +izumi/gnu/aux_cam: + NLFAIL ERC_D_Ln9.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s + NLFAIL ERC_D_Ln9.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 + NLFAIL ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba + NLFAIL ERC_D_Ln9.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s + NLFAIL ERC_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s + NLFAIL ERI_D_Ln18.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp + NLFAIL ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s + NLFAIL ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp + NLFAIL ERP_Ln9.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s + NLFAIL ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s + NLFAIL PEM_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s + NLFAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 + NLFAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 + NLFAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 + NLFAIL SCT_D_Ln7.ne3_ne3_mg37.QPC6.izumi_gnu.cam-scm_prep_c6 + NLFAIL SCT_D_Ln7.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep + NLFAIL SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 + NLFAIL SMS_D_Ln3.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc + NLFAIL SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee + NLFAIL SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac + NLFAIL SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp + - namelist compare failures due to dust_emis_inparm namelist in drv_flds_in + otherwise bit-for-bit + +Summarize any changes to answers: larger than roundoff for cam7, otherwise bit-for-bit + +=============================================================== +=============================================================== + +Tag name: cam6_4_027 +Originator(s): fvitt +Date: 3 Sep 2024 +One-line Summary: Update land model tag to ctsm5.2.027 +Github PR URL: https://github.com/ESCOMP/CAM/pull/1140 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Update of the CTSM external is needed for new dust emissions capabilities. + Issue #1139 + + The changes which affect CAM are summarized as: + ctsm5.2.016 -- changes answers for clm6_0 for crop grid cells + ctsm5.2.020 -- changes answers for all physics options for MEGAN BGVOC's which will affect CAM-Chem simulations + ctsm5.2.026 -- change answers for clm6_0 over urban grid cells + +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 .gitmodules +M components/clm + - update ctsm to ctsm5.2.027 + +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.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + 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_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d + DIFF ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h + 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 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.FSPCAMS.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 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.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.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.T42_T42.FSCAMARM97.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.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem + DIFF SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp + - expected baseline test failures + +derecho/nvhpc/aux_cam: + DIFF ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default + - expected baseline test failure + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: + DIFF SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s + - expected baseline test failure + +Summarize any changes to answers: larger than roundoff + +=============================================================== +=============================================================== + +Tag name: cam6_4_026 +Originator(s): cacraig +Date: August 29, 2024 +One-line Summary: Neglected to remove the 0.5*timestep call from zm_convr_run - done now +Github PR URL: https://github.com/ESCOMP/CAM/pull/1137 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Last change needed in https://github.com/ESCOMP/CAM/issues/1124 + +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 src/physics/cam/zm_conv_intr.F90 + - Remove "0.5*timestep" from call and replace with "timestep" + +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 + + 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.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.ne3_ne3_mg37.QPC5.derecho_intel.cam-scm_prep (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.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_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - baseline changes due to change in ZM + +derecho/nvhpc/aux_cam: + ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default (Overall: DIFF) details: + - baseline change due to change in ZM + +izumi/nag/aux_cam: + 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.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: + 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_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: + TMC_D.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + TMC_D.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + - baseline change due to change in ZM + +izumi/gnu/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.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (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.ne3_ne3_mg37.QPC6.izumi_gnu.cam-scm_prep_c6 (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: + - baseline change due to change in ZM + +Summarize any changes to answers, i.e., + Adam Harrington felt comfortable with the expected answer changes due to his previous run without this change. He felt they would + be round-off differences and authorized this commit. + +=============================================================== +=============================================================== + +Tag name: cam6_4_025 +Originator(s): fvitt, tilmes +Date: 28 Aug 2024 +One-line Summary: Repartition dust deposition fluxes passed to surface models +Github PR URL: https://github.com/ESCOMP/CAM/pull/1096 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Repartition the modal dust deposition fluxes into 4 bulk bins for passing to the surface + models. The aerosol fluxes code was refactored in a generalized way which can easily be + expanded for other aerosol representations, such as CARMA, and aerosol species types. + +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 src/chemistry/aerosol/aero_deposition_cam.F90 + - aerosol model independent module that uses aerosol abstract interface + to prepare deposition fluxes passed to surface models + +List all existing files that have been modified, and describe the changes: +M src/chemistry/aerosol/aerosol_properties_mod.F90 +M src/chemistry/aerosol/modal_aerosol_properties_mod.F90 + - add interface for calculating generalized bulk fluxes + +M src/chemistry/modal_aero/aero_model.F90 + - replace use of modal_aero_deposition with generalized aero_deposition_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. + +derecho/intel/aux_cam: + PEND 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 + + FAIL SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s + FAIL SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + 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_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 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 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.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_D_Ln9.T42_T42.FSCAMARM97.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 + - expected baseline failures due to changes in dust deposition fluxes to surface models + +derecho/nvhpc/aux_cam: + DIFF ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default + - expected baseline failure due to changes in dust deposition fluxes to surface models + +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: + 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.e23_beta02.FLTHIST_ne30.surf_flux_1995_2004_vs_f.e23_beta02.FLTHIST_ne30.001_1995_2004/website/index.html + + The land diagnostics are here: + + https://webext.cgd.ucar.edu/FLTHIST/f.e23_beta02.FLTHIST_ne30.surf_flux/lnd/f.e23_beta02.FLTHIST_ne30.surf_flux_1995_2004-f.e23_beta02.FLTHIST_ne30.001_1995_2004/setsIndex.html + +=============================================================== +=============================================================== + +Tag name: cam6_4_024 +Originator(s): eaton +Date: 27 Aug 2024 +One-line Summary: Deposition fixes for aquaplanet and simple model configurations. +Github PR URL: https://github.com/ESCOMP/CAM/pull/1120 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Issue #866 - Aquaplanet cases should not require ndep +PR #910 - No ndep in aquaplanet + +. Don't require the ndep stream for aquaplanet or simple models. Also + remove the ndep datasets from the namelist when they aren't being used. + This prevents cime from downloading large unneeded files. + This doesn't change answers since the ndep fluxes are not used by these + configurations. + +. Don't require a drydep_srf_file for aquaplanet runs on unstructured + grids. This does change answers since currently aquaplanet runs are + using the versions of this file which are meant for a CAM/CLM + configuration and are introducing an incorrect land surface signal into + the drydep calculations. + +resolves #866 +closes #910 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. build-namelist is modified to remove the settings of + stream_ndep_data_filename and stream_ndep_mesh_filename when aquaplanet + or simple model configurations are used. + +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/build-namelist +. if simple model or aquaplanet remove the settings of + stream_ndep_data_filename and stream_ndep_mesh_filename +. modify logic so the add_default call for drydep_srf_file is not made for + simple models or aquaplanet + +bld/namelist_files/namelist_definition.xml +. remove the variables in the ndep_stream_nml group. Not used. + +src/chemistry/mozart/chemistry.F90 +. chem_readnl + - add initializer for drydep_srf_file + +src/chemistry/mozart/mo_drydep.F90 +. get_landuse_and_soilw_from_file + - if drydep_srf_file not set, then set fraction_landuse to zero. + +src/cpl/nuopc/atm_import_export.F90 +. export_fields + - When ndep is not computed by WACCM, and the ndep stream isn't used, + then set Faxa_ndep to zero. + +src/cpl/nuopc/atm_stream_ndep.F90 +. add public module variable use_ndep_stream +. stream_ndep_init + - if stream_ndep_data_filename not set, then set variable + use_ndep_stream=.false. (otherwise .true.) + +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) +- 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 pend/failures -- need fix in CLM external + +ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) +ERC_D_Ln9.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s (Overall: DIFF) +ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s (Overall: DIFF) +ERI_D_Ln18.f45_f45_mg37.QPC41850.derecho_intel.cam-co2rmp_usecase (Overall: DIFF) +ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) +SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep (Overall: DIFF) +SMS_D_Ld2.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase (Overall: DIFF) +SMS_D_Ln9.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) +- expected namelist diffs due to ndep data +- expected diffs in cpl.hi file (atmImp_Faxa_ndep1, atmImp_Faxa_ndep2) + +ERC_D_Ln9.ne16_ne16_mg17.FADIAB.derecho_intel.cam-terminator (Overall: NLFAIL) +ERC_D_Ln9.T42_T42_mg17.FDABIP04.derecho_intel.cam-outfrq3s_usecase (Overall: NLFAIL) +ERC_D_Ln9.T42_T42_mg17.FHS94.derecho_intel.cam-outfrq3s_usecase (Overall: NLFAIL) +ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.derecho_intel.cam-outfrq3s_refined (Overall: NLFAIL) +SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: +- expected namelist diffs due to ndep data + +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) +SCT_D_Ln7.ne3_ne3_mg37.QPC5.derecho_intel.cam-scm_prep (Overall: DIFF) +- expected namelist diffs due to ndep data +- expected diffs in cpl.hi file (atmImp_Faxa_ndep1, atmImp_Faxa_ndep2) +- expected diffs in cam output due to fixing drydep land surface file + +derecho/nvhpc/aux_cam: PASS + +izumi/nag/aux_cam: + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) +- pre-existing failure - issue #670 + +ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) +ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) +ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) +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) +ERC_D_Ln9.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: DIFF) +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.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) +ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) +ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) +PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) +PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) +PLB_D_Ln9.f10_f10_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_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) +SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (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) +SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) +- expected namelist diffs due to ndep data +- expected diffs in cpl.hi file (atmImp_Faxa_ndep1, atmImp_Faxa_ndep2) + +ERC_D_Ln9.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) +ERI_D_Ln18.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) +ERI_D_Ln18.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) +ERS_Ln27.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: NLFAIL) +ERS_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: NLFAIL) +PEM_D_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) +SMS_D_Ln9_P1x1.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) +TMC_D.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) +TMC_D.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) +- expected namelist diffs due to ndep data + +ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) +ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (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) +- expected namelist diffs due to ndep data +- expected diffs in cpl.hi file (atmImp_Faxa_ndep1, atmImp_Faxa_ndep2) +- expected diffs in cam output due to fixing drydep land surface file + +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.ne5pg3_ne5pg3_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: +- expected namelist diffs due to ndep data + +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: +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: +- expected namelist diffs due to ndep data +- expected diffs in cpl.hi file (atmImp_Faxa_ndep1, atmImp_Faxa_ndep2) + +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.ne3_ne3_mg37.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: +SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: +- expected namelist diffs due to ndep data +- expected diffs in cpl.hi file (atmImp_Faxa_ndep1, atmImp_Faxa_ndep2) +- expected diffs in cam output due to fixing drydep land surface file + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except CAM5/6 aquaplanet runs on + unstructured grids have answer changes due to fixing the land surface + types used by dry deposition calculations + +=============================================================== +=============================================================== + +Tag name: cam6_4_023 +Originator(s): jet +Date: Aug 26, 2024 +One-line Summary: cam6_4_023: SCAM-SE feature addition plus bugfixes and some refactoring +Github PR URL: https://github.com/ESCOMP/CAM/pull/958 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +This update includes some refactoring of SCAM, a few bugfixes, and adding the capability to use +spectral elements dycore to do vertical transport in the column. The SE feature addition follows +the E3SM implementation where a complete coarse resolution (ne3np4) of the SE dycore is initialized +but only a single element is run through vertical transport. The single column chosen by scmlat, scmlon. + +Like the Eulerian version, SCAM-SE also has a bit for bit test to validate an exact run through +the same physics as the full 3d model. Because SCAM updates the solution using a slightly different +order of operations, the bfb capability is tested by making a special diagnostic run of CAM where +the 3d model derives the phys/dyn tendency each time step and then recalculates the prognostic +solution using the derived tendencies and SCAM's prognostic equation. This new solution (which is +less precise (roundoff) due to the change in order of operations) is substituted for the full 3d +solution at each time step of the model run. The substitution of the roundoff state in the 3d run +allows SCAM to reproduce (BFB) each time step using the captured tendencies in the cam iop history file. + +The SCAM-SE vertical advection skips the horizontal step and derives the floating level tendency +based on the IOP prescribed vertical velocity. The floating levels are subsequently remapped at +the end of the vertically Lagrangian dynamics step. + +Closes Issue SCAM-SE - Allow use of spectral elements dycore in single column mode. #957 +Closes Issue some SCAM IOP's are broken #853 +Closes Issue Unhelpful error message when running SCAM and IOP file is too short #742 + +Describe any changes made to build system: Allow SCAM to be built with spectral element dycore + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets:New boundary data for SE SCM + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-09-01-00000.nc + A atm/cam/inic/se/cami_0000-01-01_ne3np4_L30_c120315.nc + A atm/cam/inic/se/cami_0000-01-01_ne3np4_L26_c120525.nc + A atm/cam/topo/se/ne3np4_gmted2010_modis_bedmachine_nc0540_Laplace1000_noleak_20230717.nc + A atm/cam/chem/trop_mam/atmsrf_ne3np4_230718.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-01-01-00000.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-02-01-00000.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-04-01-00000.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-06-01-00000.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-07-01-00000.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-08-01-00000.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-10-01-00000.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-12-01-00000.nc + A atm/cam/scam/iop/micre2017_3mo.cam.i.2017-01-01-00000.regrid.ne3np4.nc + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume, cacraig + +List all files eliminated: + + D bld/namelist_files/use_cases/scam_arm95.xml + D bld/namelist_files/use_cases/scam_arm97.xml + D bld/namelist_files/use_cases/scam_gateIII.xml + D bld/namelist_files/use_cases/scam_mpace.xml + D bld/namelist_files/use_cases/scam_sparticus.xml + D bld/namelist_files/use_cases/scam_togaII.xml + D bld/namelist_files/use_cases/scam_twp06.xml + - These are now available via xml defaults + D cime_config/usermods_dirs/scam_arm95/shell_commands + D cime_config/usermods_dirs/scam_arm95/user_nl_cam + D cime_config/usermods_dirs/scam_arm97/shell_commands + D cime_config/usermods_dirs/scam_arm97/user_nl_cam + D cime_config/usermods_dirs/scam_atex/shell_commands + D cime_config/usermods_dirs/scam_atex/user_nl_cam + D cime_config/usermods_dirs/scam_bomex/user_nl_cam + D cime_config/usermods_dirs/scam_cgilsS11/shell_commands + D cime_config/usermods_dirs/scam_cgilsS11/user_nl_cam + D cime_config/usermods_dirs/scam_cgilsS12/shell_commands + D cime_config/usermods_dirs/scam_cgilsS12/user_nl_cam + D cime_config/usermods_dirs/scam_cgilsS6/shell_commands + D cime_config/usermods_dirs/scam_cgilsS6/user_nl_cam + D cime_config/usermods_dirs/scam_dycomsRF01/shell_commands + D cime_config/usermods_dirs/scam_dycomsRF01/user_nl_cam + D cime_config/usermods_dirs/scam_dycomsRF02/shell_commands + D cime_config/usermods_dirs/scam_dycomsRF02/user_nl_cam + D cime_config/usermods_dirs/scam_gateIII/shell_commands + D cime_config/usermods_dirs/scam_gateIII/user_nl_cam + D cime_config/usermods_dirs/scam_micre2017/shell_commands + D cime_config/usermods_dirs/scam_micre2017/user_nl_cam + D cime_config/usermods_dirs/scam_mpace/shell_commands + D cime_config/usermods_dirs/scam_mpace/user_nl_cam + D cime_config/usermods_dirs/scam_rico/shell_commands + D cime_config/usermods_dirs/scam_rico/user_nl_cam + D cime_config/usermods_dirs/scam_SAS/shell_commands + D cime_config/usermods_dirs/scam_SAS/user_nl_cam + D cime_config/usermods_dirs/scam_sparticus/shell_commands + D cime_config/usermods_dirs/scam_sparticus/user_nl_cam + D cime_config/usermods_dirs/scam_togaII/shell_commands + D cime_config/usermods_dirs/scam_togaII/user_nl_cam + D cime_config/usermods_dirs/scam_twp06/shell_commands + D cime_config/usermods_dirs/scam_twp06/user_nl_cam + - replace by xml defaults + D cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/include_user_mods + D cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/shell_commands + D cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cam + D cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_clm + D cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cpl + - no longer valid for mpace setup + D src/control/history_defaults.F90 + - after moving scam specific code there was nothing left here + + +List all files added and what they do: N/A + A cime_config/usermods_dirs/scam_camfrc/shell_commands + A cime_config/usermods_dirs/scam_camfrc/user_nl_cam + A cime_config/usermods_dirs/scam_mandatory/shell_commands + - template directories for usermods to scam. + + A src/dynamics/se/apply_iop_forcing.F90 + A src/dynamics/se/dycore/se_single_column_mod.F90 + - enable iop forcing for SE SCM + +List all existing files that have been modified, and describe the changes: + M .gitmodules + - update cice to fix scam failure + - update cdeps to fix CDEPS regression test build failures + M bld/build-namelist + - update namelist defaults for scm relaxation. + M bld/config_files/definition.xml + - new configurations option for scam_iops + M bld/configure + - new configure options for SCAM refactor + M bld/namelist_files/namelist_defaults_cam.xml + M bld/namelist_files/namelist_definition.xml + - new configurations option for scam_iops + M cime_config/buildcpp + - setup new build for se SCAM test + M cime_config/config_component.xml + M cime_config/config_compsets.xml + - add scam defaults to cime + M cime_config/config_pes.xml + - add scam se pe defaults + M cime_config/SystemTests/sct.py + - setup new BFB se SCAM test + M cime_config/testdefs/testlist_cam.xml + - fix mpace test and add test_scam category + M cime_config/testdefs/testmods_dirs/cam/scmarm/shell_commands + - add new scam se regression tests + M cime_config/usermods_dirs/scam_mandatory/shell_commands + - add warmstart logic + M src/control/cam_comp.F90 + - cleanup some of the BFB_CAM_SCAM_IOP cppdefs + M src/control/cam_history.F90 + - set write_camiop logical if CAMIOP history type is requested by user. + M src/control/getinterpnetcdfdata.F90 + M src/control/history_scam.F90 + - generalize for output on single column grid + M src/control/ncdio_atm.F90 + - add physgrid_scm, scam uses the full physgrid to read data from boundary and + M src/control/scamMod.F90 + - new control parameters for SCAM-SE + M src/dynamics/eul/diag_dynvar_ic.F90 + M src/dynamics/eul/dyn_comp.F90 + M src/dynamics/eul/dynpkg.F90 + - remove more scam CPP defines + M src/dynamics/eul/dyn_grid.F90 + M src/dynamics/eul/iop.F90 + - generalize to use common routines for SE and EUL + M src/dynamics/eul/restart_dynamics.F90 + - remove more scam CPP defines + M src/dynamics/eul/scmforecast.F90 + M src/dynamics/eul/stepon.F90 + M src/dynamics/eul/tfilt_massfix.F90 + - refactor/cleanup + M src/dynamics/se/advect_tend.F90 + - capture SE advective tendencies for BFB testing + M src/dynamics/se/dp_coupling.F90 + - phys/dyn interface additions for SE-SCAM + M src/dynamics/se/dycore/prim_advance_mod.F90 + M src/dynamics/se/dycore/prim_driver_mod.F90 + M src/dynamics/se/dycore/vertremap_mod.F90 + M src/dynamics/se/dycore/viscosity_mod.F90 + - refactor/cleanup + M src/dynamics/se/dyn_comp.F90 + M src/dynamics/se/dyn_grid.F90 + - add SE single column mod + M src/dynamics/se/gravity_waves_sources.F90 + - hvcoord + M src/dynamics/se/stepon.F90 + - add SE SCAM iop update calls + M src/infrastructure/phys_grid.F90 + - update for single column phys grid + M src/physics/cam7/physpkg.F90 + M src/physics/cam/cam_diagnostics.F90 + - clean up BFB cpp defs + M src/physics/cam/check_energy.F90 + - add heat_glob for SE iop + M src/physics/cam/chem_surfvals.F90 + - add column initialization for greenhouse gasses + M src/physics/cam/clubb_intr.F90 + - use model grid box size not arbitrary SCM column size + M src/physics/cam/convect_shallow.F90 + - add DQP diagnostic + M src/physics/cam/phys_grid.F90 + - define scm single column grid for scm history + M src/physics/cam/physpkg.F90 + - clean up BFB cpp defs + M src/utils/cam_grid_support.F90 + - add trim to grid name + M src/utils/hycoef.F90 + - add hvcoord struct + + +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 pend/failures -- need fix in CLM external + + SCT_D_Ln7.ne3_ne3_mg37.QPC5.derecho_intel.cam-scm_prep BFAIL + - New Test; Failure expected (SCAM on spectral element grid) + + SMS_D_Ln9.T42_T42.FSCAMARM97.derecho_intel.cam-outfrq9s BFAIL + - New Test; Failure expected; FSCAM compset named changed to FSCAMARM97 + + SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep (Overall: DIFF) details: + - Roundoff answer changes expected to existing SCAM prep cases + + SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + - Expected differenc due to cice update, only 2 fields different as new cice has annual restarts off. + + ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: NLFAIL) details: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) details: + ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: NLFAIL) details: + ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: NLFAIL) details: + ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: NLFAIL) details: + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: NLFAIL) details: + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: NLFAIL) details: + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: NLFAIL) details: + SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: NLFAIL) details: + SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: NLFAIL) details: + SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: NLFAIL) details: + SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: NLFAIL) details: + SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: NLFAIL) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: NLFAIL) details + - Expected failures, In addition to differences these tests also failed namelist comparisons due to the updated cice + +derecho/nvhpc/aux_cam: + ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default (Overall: NLFAIL) + - Expected failures due to the updated cice + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure - issue #670 + SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) details: + - Roundoff answer changes expected to existing SCAM cases + +izumi/gnu/aux_cam: + SCT_D_Ln7.ne3_ne3_mg37.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: FAIL) + - New Test Failure expected. + 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: + - Roundoff answer changes expected to existing SCAM cases + SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + - Expected namelist failure due to cice update. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: SCAM tests +- what platforms/compilers: All +- nature of change (roundoff; larger than roundoff but same climate; new + climate): new climate - larger changes confined to top levels that were ignored in previous versions. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +=============================================================== +=============================================================== + +Tag name: cam6_4_022 +Originator(s): cacraig +Date: Aug 19, 2024 +One-line Summary: Remove 0.5*timestep from call to ZM +Github PR URL: https://github.com/ESCOMP/CAM/pull/1127 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Remove half timestep from ZM code: https://github.com/ESCOMP/CAM/issues/1124 + +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 .gitmodules +M src/atmos_phys + - Update atmos_phys tag to bring in the ZM changes from it + +M src/physics/cam/zm_conv_intr.F90 +M src/physics/spcam/crmclouds_camaerosols.F90 + - Change the CAM calls to 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: + +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.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.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.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_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - Roundoff answer changes expected + +derecho/nvhpc/aux_cam: + ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default (Overall: DIFF) details: + - Roundoff answer changes expected + + +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.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.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: + 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_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: + TMC_D.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + TMC_D.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + - Roundoff answer changes expected + +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-rad_diag (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: + - Roundoff answer changes expected + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: All which call ZM +- what platforms/compilers: All +- nature of change (roundoff; larger than roundoff but same climate; new + climate): roundoff + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + - Conclusion reached by Adam Harrington - See issue for testing details + +=============================================================== +=============================================================== + +Tag name: cam6_4_021 +Originator(s): jet +Date: 16 Aug 2024 +One-line Summary: CCPPize dadadj +Github PR URL: https://github.com/ESCOMP/CAM/pull/1026 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Issue #928 - Convert Dry Adiabatic Adjustment to CCPP and move into the atmospheric_physics github repo + - Bugfix to dadadj although it didn't change answers in the regression suite. + +Describe any changes made to build system: add atmos_phys/dry_adiabatic_adjust directory to build filepath + +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, nusbaume + +List all files eliminated: +D physics/cam/dadadj.F90 + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M .gitmodules + - update to atmospheric_physics tag with new dry_adiabatic_adjust ccpp routine + +M bld/configure + - Add dry_adiabatic_adjust to build Filepath +M src/cam_snapshot_common.F90 + - update pbuf_snapshot fields from 250 to 300 +M physics/cam/dadadj_cam.F90 + - CCPP'ize dadadj interface +M physics/physpkg.F90 +M physics/cam7/physpkg.F90 + - update subroutine name for cam dadadj initialization + +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 + +derecho/nvphc/aux_cam: All Pass + +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_020 +Originator(s): fvitt +Date: 14 Aug 2024 +One-line Summary: Correction to aerosol convective removal and other misc fixes +Github PR URL: https://github.com/ESCOMP/CAM/pull/1111 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Fixes to the follow: + . an error in the calculation of dz in the aerosol convective removal code + . issue #1030 -- Incorrect waccm_forcing namelist settings in FWsc2000climo and FWsc2010climo compsets + . issue #1125 -- archive_baselines does not append compiler onto derecho baselines properly + +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 bld/namelist_files/use_cases/waccm_sc_2000_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_2010_cam6.xml + - corrections to waccm_forcing namelist settings + +M src/chemistry/modal_aero/modal_aero_convproc.F90 + - correctly calculate dz + - misc code clean up + +M test/system/archive_baseline.sh + - append compiler name to tag name used in baseline path + +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 + + FAIL SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s + - pre-existing failure -- need fix in CICE external + + 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 + + DIFF ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp + 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 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.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.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp + - expected baseline test failures due to correction in modal_aero_convproc + +derecho/nvhpc/aux_cam: + DIFF ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default + - expected baseline test failure due to correction in modal_aero_convproc + +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.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 ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 + DIFF SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase + - expected baseline test failures due to correction in modal_aero_convproc + +izumi/gnu/aux_cam: + 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 SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 + - expected baseline test failures due to correction in modal_aero_convproc + +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.e23_beta02.FLTHIST_ne30.conv_dz_bug_1995_2004_vs_f.e23_beta02.FLTHIST_ne30.001_1995_2004/website/index.html + https://acomstaff.acom.ucar.edu/tilmes/amwg/cam7/f.cam6_3_160.FMTHIST_ne30.moving_mtn.output.conv7_1996_2004_vs_f.cam6_3_160.FMTHIST_ne30.moving_mtn.output.conv6_1996_2004/website/html_table/mean_tables.html + +=============================================================== +=============================================================== + +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 @@ -38,7 +5782,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: @@ -124,7 +5868,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..d9d0e5d9bf --- /dev/null +++ b/src/atmos_phys @@ -0,0 +1 @@ +Subproject commit d9d0e5d9bf96e5386ccb264bf123f8007db5821d diff --git a/src/chemistry/aerosol/aero_deposition_cam.F90 b/src/chemistry/aerosol/aero_deposition_cam.F90 new file mode 100644 index 0000000000..d22119c6b4 --- /dev/null +++ b/src/chemistry/aerosol/aero_deposition_cam.F90 @@ -0,0 +1,336 @@ +module aero_deposition_cam +!------------------------------------------------------------------------------ +! Purpose: +! +! Partition the contributions from aerosols of wet and dry +! deposition at the surface into the fields passed to the coupler. +!------------------------------------------------------------------------------ + + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_kind_mod, only: cl => shr_kind_cl + use constituents, only: cnst_get_ind, pcnst + use camsrfexch, only: cam_out_t + use cam_abortutils,only: endrun + use aerosol_properties_mod, only: aero_name_len + use aerosol_properties_mod, only: aerosol_properties + + implicit none + + private + +! Public interfaces + + public :: aero_deposition_cam_init + public :: aero_deposition_cam_setwet + public :: aero_deposition_cam_setdry + +! Private module data + + integer :: bcphi_ndx( pcnst ) = -1 + integer :: bcphi_cnt = 0 + integer :: bcpho_ndx( pcnst ) = -1 + integer :: bcpho_cnt = 0 + integer :: ocphi_ndx( pcnst ) = -1 + integer :: ocphi_cnt = 0 + integer :: ocpho_ndx( pcnst ) = -1 + integer :: ocpho_cnt = 0 + + class(aerosol_properties), pointer :: aero_props=>null() + integer :: nele_tot=0 ! total number of aerosol elements + + ! bulk dust bins (meters) + + integer, parameter :: n_bulk_dst_bins = 4 + + ! CAM4 bulk dust bin sizes (https://doi.org/10.1002/2013MS000279) + real(r8), parameter :: bulk_dst_edges(n_bulk_dst_bins+1) = & + (/0.1e-6_r8, 1.0e-6_r8, 2.5e-6_r8, 5.0e-6_r8, 10.e-6_r8/) + +contains + + !============================================================================ + subroutine aero_deposition_cam_init(aero_props_in) + + class(aerosol_properties),target, intent(in) :: aero_props_in + + integer :: pcnt, scnt + character(len=*), parameter :: subrname = 'aero_deposition_cam_init' + + ! construct the aerosol properties object + aero_props => aero_props_in + + ! set the cam constituent indices and determine the counts + ! for the specified aerosol types + + ! black carbons + call get_indices( type='black-c', hydrophilic=.true., indices=bcphi_ndx, count=bcphi_cnt ) + call get_indices( type='black-c', hydrophilic=.false., indices=bcpho_ndx, count=bcpho_cnt ) + + ! primary and secondary organics + call get_indices( type='p-organic',hydrophilic=.true., indices=ocphi_ndx, count=pcnt ) + call get_indices( type='s-organic',hydrophilic=.true., indices=ocphi_ndx(pcnt+1:), count=scnt ) + ocphi_cnt = pcnt+scnt + + call get_indices( type='p-organic',hydrophilic=.false., indices=ocpho_ndx, count=pcnt ) + call get_indices( type='s-organic',hydrophilic=.false., indices=ocpho_ndx(pcnt+1:), count=scnt ) + ocpho_cnt = pcnt+scnt + + ! total number of aerosol elements + nele_tot = aero_props%ncnst_tot() + + contains + + !========================================================================== + ! returns CAM constituent indices of the aerosol tracers (and count) + !========================================================================== + subroutine get_indices( type, hydrophilic, indices, count) + + character(len=*), intent(in) :: type + logical, intent(in ) :: hydrophilic + integer, intent(out) :: indices(:) + integer, intent(out) :: count + + integer :: ibin,ispc, ndx, nspec + character(len=aero_name_len) :: spec_type, spec_name + + count = 0 + indices(:) = -1 + + ! loop through aerosol bins / modes + do ibin = 1, aero_props%nbins() + + ! check if the bin/mode is hydrophilic + if ( aero_props%hydrophilic(ibin) .eqv. hydrophilic ) then + do ispc = 1, aero_props%nspecies(ibin) + + call aero_props%get(ibin,ispc, spectype=spec_type, specname=spec_name) + + if (spec_type==type) then + + ! get CAM constituent index + call cnst_get_ind(spec_name, ndx, abort=.false.) + if (ndx>0) then + count = count+1 + indices(count) = ndx + endif + + endif + + enddo + endif + + enddo + + end subroutine get_indices + + end subroutine aero_deposition_cam_init + + !============================================================================ + ! Set surface wet deposition fluxes passed to coupler. + !============================================================================ + subroutine aero_deposition_cam_setwet(aerdepwetis, aerdepwetcw, cam_out) + + ! Arguments: + real(r8), intent(in) :: aerdepwetis(:,:) ! aerosol wet deposition (interstitial) + real(r8), intent(in) :: aerdepwetcw(:,:) ! aerosol wet deposition (cloud water) + type(cam_out_t), intent(inout) :: cam_out ! cam export state + + ! Local variables: + integer :: i, ispec, ibin, mm, ndx + integer :: ncol ! number of columns + + real(r8) :: dep_fluxes(nele_tot) + real(r8) :: dst_fluxes(n_bulk_dst_bins) + character(len=aero_name_len) :: specname, name_c + integer :: errstat + character(len=cl) :: errstr + + ncol = cam_out%ncol + + cam_out%bcphiwet(:) = 0._r8 + cam_out%ocphiwet(:) = 0._r8 + cam_out%dstwet1(:) = 0._r8 + cam_out%dstwet2(:) = 0._r8 + cam_out%dstwet3(:) = 0._r8 + cam_out%dstwet4(:) = 0._r8 + + ! derive cam_out variables from deposition fluxes + ! note: wet deposition fluxes are negative into surface, + ! dry deposition fluxes are positive into surface. + ! srf models want positive definite fluxes. + do i = 1, ncol + + ! hydrophilic black carbon fluxes + do ispec=1,bcphi_cnt + cam_out%bcphiwet(i) = cam_out%bcphiwet(i) & + - (aerdepwetis(i,bcphi_ndx(ispec))+aerdepwetcw(i,bcphi_ndx(ispec))) + enddo + + ! hydrophobic black carbon fluxes + do ispec=1,bcpho_cnt + cam_out%bcphiwet(i) = cam_out%bcphiwet(i) & + - (aerdepwetis(i,bcpho_ndx(ispec))+aerdepwetcw(i,bcpho_ndx(ispec))) + enddo + + ! hydrophilic organic carbon fluxes + do ispec=1,ocphi_cnt + cam_out%ocphiwet(i) = cam_out%ocphiwet(i) & + - (aerdepwetis(i,ocphi_ndx(ispec))+aerdepwetcw(i,ocphi_ndx(ispec))) + enddo + + ! hydrophobic organic carbon fluxes + do ispec=1,ocpho_cnt + cam_out%ocphiwet(i) = cam_out%ocphiwet(i) & + - (aerdepwetis(i,ocpho_ndx(ispec))+aerdepwetcw(i,ocpho_ndx(ispec))) + enddo + + ! dust fluxes + + dep_fluxes = 0._r8 + dst_fluxes = 0._r8 + + do ibin = 1,aero_props%nbins() + do ispec = 0,aero_props%nmasses(ibin) + if (ispec==0) then + call aero_props%num_names(ibin, specname, name_c) + else + call aero_props%get(ibin,ispec, specname=specname) + end if + call cnst_get_ind(specname, ndx, abort=.false.) + if (ndx>0) then + mm = aero_props%indexer(ibin,ispec) + dep_fluxes(mm) = - (aerdepwetis(i,ndx)+aerdepwetcw(i,ndx)) + end if + end do + end do + + ! rebin dust fluxes to bulk dust bins + call aero_props%rebin_bulk_fluxes('dust', dep_fluxes, bulk_dst_edges, dst_fluxes, errstat, errstr) + if (errstat/=0) then + call endrun('aero_deposition_cam_setwet: '//trim(errstr)) + end if + + cam_out%dstwet1(i) = cam_out%dstwet1(i) + dst_fluxes(1) + cam_out%dstwet2(i) = cam_out%dstwet2(i) + dst_fluxes(2) + cam_out%dstwet3(i) = cam_out%dstwet3(i) + dst_fluxes(3) + cam_out%dstwet4(i) = cam_out%dstwet4(i) + dst_fluxes(4) + + ! in rare cases, integrated deposition tendency is upward + if (cam_out%bcphiwet(i) < 0._r8) cam_out%bcphiwet(i) = 0._r8 + if (cam_out%ocphiwet(i) < 0._r8) cam_out%ocphiwet(i) = 0._r8 + if (cam_out%dstwet1(i) < 0._r8) cam_out%dstwet1(i) = 0._r8 + if (cam_out%dstwet2(i) < 0._r8) cam_out%dstwet2(i) = 0._r8 + if (cam_out%dstwet3(i) < 0._r8) cam_out%dstwet3(i) = 0._r8 + if (cam_out%dstwet4(i) < 0._r8) cam_out%dstwet4(i) = 0._r8 + + enddo + + end subroutine aero_deposition_cam_setwet + + !============================================================================ + ! Set surface dry deposition fluxes passed to coupler. + !============================================================================ + subroutine aero_deposition_cam_setdry(aerdepdryis, aerdepdrycw, cam_out) + + ! Arguments: + real(r8), intent(in) :: aerdepdryis(:,:) ! aerosol dry deposition (interstitial) + real(r8), intent(in) :: aerdepdrycw(:,:) ! aerosol dry deposition (cloud water) + type(cam_out_t), intent(inout) :: cam_out ! cam export state + + ! Local variables: + integer :: i, ispec, ibin, mm, ndx + integer :: ncol ! number of columns + + real(r8) :: dep_fluxes(nele_tot) + real(r8) :: dst_fluxes(n_bulk_dst_bins) + character(len=aero_name_len) :: specname, name_c + integer :: errstat + character(len=cl) :: errstr + + ncol = cam_out%ncol + + cam_out%bcphidry(:) = 0._r8 + cam_out%ocphidry(:) = 0._r8 + cam_out%bcphodry(:) = 0._r8 + cam_out%ocphodry(:) = 0._r8 + cam_out%dstdry1(:) = 0._r8 + cam_out%dstdry2(:) = 0._r8 + cam_out%dstdry3(:) = 0._r8 + cam_out%dstdry4(:) = 0._r8 + + ! derive cam_out variables from deposition fluxes + ! note: wet deposition fluxes are negative into surface, + ! dry deposition fluxes are positive into surface. + ! srf models want positive definite fluxes. + do i = 1, ncol + + ! hydrophilic black carbon fluxes + do ispec=1,bcphi_cnt + cam_out%bcphidry(i) = cam_out%bcphidry(i) & + + (aerdepdryis(i,bcphi_ndx(ispec))+aerdepdrycw(i,bcphi_ndx(ispec))) + enddo + + ! hydrophobic black carbon fluxes + do ispec=1,bcpho_cnt + cam_out%bcphodry(i) = cam_out%bcphodry(i) & + + (aerdepdryis(i,bcpho_ndx(ispec))+aerdepdrycw(i,bcpho_ndx(ispec))) + enddo + + ! hydrophilic organic carbon fluxes + do ispec=1,ocphi_cnt + cam_out%ocphidry(i) = cam_out%ocphidry(i) & + + (aerdepdryis(i,ocphi_ndx(ispec))+aerdepdrycw(i,ocphi_ndx(ispec))) + enddo + + ! hydrophobic organic carbon fluxes + do ispec=1,ocpho_cnt + cam_out%ocphodry(i) = cam_out%ocphodry(i) & + + (aerdepdryis(i,ocpho_ndx(ispec))+aerdepdrycw(i,ocpho_ndx(ispec))) + enddo + + ! dust fluxes + + dep_fluxes = 0._r8 + dst_fluxes = 0._r8 + + do ibin = 1,aero_props%nbins() + do ispec = 0,aero_props%nspecies(ibin) + if (ispec==0) then + call aero_props%num_names(ibin, specname, name_c) + else + call aero_props%get(ibin,ispec, specname=specname) + end if + call cnst_get_ind(specname, ndx, abort=.false.) + if (ndx>0) then + mm = aero_props%indexer(ibin,ispec) + dep_fluxes(mm) = aerdepdryis(i,ndx)+aerdepdrycw(i,ndx) + end if + end do + end do + + ! rebin dust fluxes to bulk dust bins + call aero_props%rebin_bulk_fluxes('dust', dep_fluxes, bulk_dst_edges, dst_fluxes, errstat, errstr) + if (errstat/=0) then + call endrun('aero_deposition_cam_setdry: '//trim(errstr)) + end if + + cam_out%dstdry1(i) = cam_out%dstdry1(i) + dst_fluxes(1) + cam_out%dstdry2(i) = cam_out%dstdry2(i) + dst_fluxes(2) + cam_out%dstdry3(i) = cam_out%dstdry3(i) + dst_fluxes(3) + cam_out%dstdry4(i) = cam_out%dstdry4(i) + dst_fluxes(4) + + ! in rare cases, integrated deposition tendency is upward + if (cam_out%bcphidry(i) < 0._r8) cam_out%bcphidry(i) = 0._r8 + if (cam_out%ocphidry(i) < 0._r8) cam_out%ocphidry(i) = 0._r8 + if (cam_out%bcphodry(i) < 0._r8) cam_out%bcphodry(i) = 0._r8 + if (cam_out%ocphodry(i) < 0._r8) cam_out%ocphodry(i) = 0._r8 + if (cam_out%dstdry1(i) < 0._r8) cam_out%dstdry1(i) = 0._r8 + if (cam_out%dstdry2(i) < 0._r8) cam_out%dstdry2(i) = 0._r8 + if (cam_out%dstdry3(i) < 0._r8) cam_out%dstdry3(i) = 0._r8 + if (cam_out%dstdry4(i) < 0._r8) cam_out%dstdry4(i) = 0._r8 + + enddo + + end subroutine aero_deposition_cam_setdry + +end module aero_deposition_cam diff --git a/src/chemistry/aerosol/aerosol_properties_mod.F90 b/src/chemistry/aerosol/aerosol_properties_mod.F90 index aadd56f87d..c94f277637 100644 --- a/src/chemistry/aerosol/aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/aerosol_properties_mod.F90 @@ -70,6 +70,8 @@ module aerosol_properties_mod procedure(aero_min_mass_mean_rad), deferred :: min_mass_mean_rad procedure(aero_optics_params), deferred :: optics_params procedure(aero_bin_name), deferred :: bin_name + procedure(aero_rebin_bulk_fluxes), deferred :: rebin_bulk_fluxes + procedure(aero_hydrophilic), deferred :: hydrophilic procedure :: final=>aero_props_final end type aerosol_properties @@ -91,12 +93,13 @@ end function aero_number_transported ! density ! hygroscopicity ! species type + ! species name ! short wave species refractive indices ! long wave species refractive indices ! species morphology !------------------------------------------------------------------------ subroutine aero_props_get(self, bin_ndx, species_ndx, list_ndx, density, hygro, & - spectype, specmorph, refindex_sw, refindex_lw) + spectype, specname, specmorph, refindex_sw, refindex_lw) import :: aerosol_properties, r8 class(aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin index @@ -105,6 +108,7 @@ subroutine aero_props_get(self, bin_ndx, species_ndx, list_ndx, density, hygro, real(r8), optional, intent(out) :: density ! density (kg/m3) real(r8), optional, intent(out) :: hygro ! hygroscopicity character(len=*), optional, intent(out) :: spectype ! species type + character(len=*), optional, intent(out) :: specname ! species name character(len=*), optional, intent(out) :: specmorph ! species morphology complex(r8), pointer, optional, intent(out) :: refindex_sw(:) ! short wave species refractive indices complex(r8), pointer, optional, intent(out) :: refindex_lw(:) ! long wave species refractive indices @@ -378,6 +382,32 @@ function aero_bin_name(self, list_ndx, bin_ndx) result(name) end function aero_bin_name + !------------------------------------------------------------------------------ + ! returns bulk deposition fluxes of the specified species type + ! rebinned to specified diameter limits + !------------------------------------------------------------------------------ + subroutine aero_rebin_bulk_fluxes(self, bulk_type, dep_fluxes, diam_edges, bulk_fluxes, & + error_code, error_string) + import :: aerosol_properties, r8 + class(aerosol_properties), intent(in) :: self + character(len=*),intent(in) :: bulk_type ! aerosol type to rebin + real(r8), intent(in) :: dep_fluxes(:) ! kg/m2 + real(r8), intent(in) :: diam_edges(:) ! meters + real(r8), intent(out) :: bulk_fluxes(:) ! kg/m2 + integer, intent(out) :: error_code ! error code (0 if no error) + character(len=*), intent(out) :: error_string ! error string + + end subroutine aero_rebin_bulk_fluxes + + !------------------------------------------------------------------------------ + ! Returns TRUE if bin is hydrophilic, otherwise FALSE + !------------------------------------------------------------------------------ + logical function aero_hydrophilic(self, bin_ndx) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + end function aero_hydrophilic + end interface contains diff --git a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 index 66cee40480..54f64fa759 100644 --- a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 @@ -36,6 +36,8 @@ module modal_aerosol_properties_mod procedure :: soluble procedure :: min_mass_mean_rad procedure :: bin_name + procedure :: rebin_bulk_fluxes + procedure :: hydrophilic final :: destructor end type modal_aerosol_properties @@ -44,6 +46,8 @@ module modal_aerosol_properties_mod procedure :: constructor end interface modal_aerosol_properties + logical, parameter :: debug = .false. + contains !------------------------------------------------------------------------------ @@ -182,12 +186,13 @@ end function number_transported ! density ! hygroscopicity ! species type + ! species name ! short wave species refractive indices ! long wave species refractive indices ! species morphology !------------------------------------------------------------------------ subroutine get(self, bin_ndx, species_ndx, list_ndx, density, hygro, & - spectype, specmorph, refindex_sw, refindex_lw) + spectype, specname, specmorph, refindex_sw, refindex_lw) class(modal_aerosol_properties), intent(in) :: self integer, intent(in) :: bin_ndx ! bin index @@ -196,6 +201,7 @@ subroutine get(self, bin_ndx, species_ndx, list_ndx, density, hygro, & real(r8), optional, intent(out) :: density ! density (kg/m3) real(r8), optional, intent(out) :: hygro ! hygroscopicity character(len=*), optional, intent(out) :: spectype ! species type + character(len=*), optional, intent(out) :: specname ! species name character(len=*), optional, intent(out) :: specmorph ! species morphology complex(r8), pointer, optional, intent(out) :: refindex_sw(:) ! short wave species refractive indices complex(r8), pointer, optional, intent(out) :: refindex_lw(:) ! long wave species refractive indices @@ -212,6 +218,10 @@ subroutine get(self, bin_ndx, species_ndx, list_ndx, density, hygro, & density_aer=density, hygro_aer=hygro, spectype=spectype, & refindex_aer_sw=refindex_sw, refindex_aer_lw=refindex_lw) + if (present(specname)) then + call rad_cnst_get_info(ilist, bin_ndx, species_ndx, spec_name=specname) + end if + if (present(specmorph)) then specmorph = 'UNKNOWN' end if @@ -665,4 +675,114 @@ function bin_name(self, list_ndx, bin_ndx) result(name) end function bin_name + !------------------------------------------------------------------------------ + ! returns bulk deposition fluxes of the specified species type + ! rebinned to specified diameter limits + !------------------------------------------------------------------------------ + subroutine rebin_bulk_fluxes(self, bulk_type, dep_fluxes, diam_edges, bulk_fluxes, & + error_code, error_string) + use infnan, only: nan, assignment(=) + + class(modal_aerosol_properties), intent(in) :: self + character(len=*),intent(in) :: bulk_type ! aerosol type to rebin + real(r8), intent(in) :: dep_fluxes(:) ! kg/m2 + real(r8), intent(in) :: diam_edges(:) ! meters + real(r8), intent(out) :: bulk_fluxes(:) ! kg/m2 + integer, intent(out) :: error_code ! error code (0 if no error) + character(len=*), intent(out) :: error_string ! error string + + real(r8) :: dns_dst ! kg/m3 + real(r8) :: sigma_g, vmd, tmp, massfrac_bin(size(bulk_fluxes)) + real(r8) :: Ntype, Mtype, Mtotal, Ntot + integer :: k,l,m,mm, nbulk + logical :: has_type, type_not_found + + character(len=aero_name_len) :: spectype + character(len=aero_name_len) :: modetype + + real(r8), parameter :: sqrtwo = sqrt(2._r8) + real(r8), parameter :: onethrd = 1._r8/3._r8 + + error_code = 0 + error_string = ' ' + + type_not_found = .true. + + nbulk = size(bulk_fluxes) + + bulk_fluxes(:) = 0.0_r8 + + do m = 1,self%nbins() + Mtype = 0._r8 + Mtotal = 0._r8 + mm = self%indexer(m,0) + Ntot = dep_fluxes(mm) ! #/m2 + + has_type = .false. + + do l = 1,self%nspecies(m) + mm = self%indexer(m,l) + call self%get(m,l, spectype=spectype, density=dns_dst) ! kg/m3 + if (spectype==bulk_type) then + Mtype = dep_fluxes(mm) ! kg/m2 + has_type = .true. + type_not_found = .false. + end if + Mtotal = Mtotal + dep_fluxes(mm) ! kg/m2 + end do + mode_has_type: if (has_type) then + call rad_cnst_get_info(0, m, mode_type=modetype) + if (Ntot>1.e-40_r8 .and. Mtype>1.e-40_r8 .and. Mtotal>1.e-40_r8) then + + call rad_cnst_get_mode_props(0, m, sigmag=sigma_g) + tmp = sqrtwo*log(sigma_g) + + ! type number concentration + Ntype = Ntot * Mtype/Mtotal ! #/m2 + + ! volume median diameter (meters) + vmd = (6._r8*Mtype/(pi*Ntype*dns_dst))**onethrd * exp(1.5_r8*(log(sigma_g))**2) + + massfrac_bin = 0._r8 + + do k = 1,nbulk + massfrac_bin(k) = 0.5_r8*( erf((log(diam_edges(k+1)/vmd))/tmp) & + - erf((log(diam_edges(k )/vmd))/tmp) ) + bulk_fluxes(k) = bulk_fluxes(k) + massfrac_bin(k) * Mtype + end do + + if (debug) then + if (abs(1._r8-sum(massfrac_bin)) > 1.e-6_r8) then + write(*,*) 'rebin_bulk_fluxes WARNING mode-num, massfrac_bin, sum(massfrac_bin) = ', & + m, massfrac_bin, sum(massfrac_bin) + end if + end if + + end if + end if mode_has_type + end do + + if (type_not_found) then + bulk_fluxes(:) = nan + error_code = 1 + write(error_string,*) 'aerosol_properties::rebin_bulk_fluxes ERROR : ',trim(bulk_type),' not found' + end if + + end subroutine rebin_bulk_fluxes + + !------------------------------------------------------------------------------ + ! Returns TRUE if bin is hydrophilic, otherwise FALSE + !------------------------------------------------------------------------------ + logical function hydrophilic(self, bin_ndx) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + character(len=aero_name_len) :: modetype + + call rad_cnst_get_info(0, bin_ndx, mode_type=modetype) + + hydrophilic = (trim(modetype) == 'accum') + + end function hydrophilic + end module modal_aerosol_properties_mod 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/bulk_aero/dust_model.F90 b/src/chemistry/bulk_aero/dust_model.F90 index 1a0ff4c5aa..6b559200c6 100644 --- a/src/chemistry/bulk_aero/dust_model.F90 +++ b/src/chemistry/bulk_aero/dust_model.F90 @@ -1,10 +1,12 @@ !=============================================================================== ! Dust for Bulk Aerosol Model !=============================================================================== -module dust_model +module dust_model use shr_kind_mod, only: r8 => shr_kind_r8, cl => shr_kind_cl use spmd_utils, only: masterproc use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use shr_dust_emis_mod,only: is_dust_emis_zender, is_zender_soil_erod_from_atm implicit none private @@ -34,8 +36,9 @@ module dust_model real(r8) :: dust_dmt_vwr(dust_nbin) real(r8) :: dust_stk_crc(dust_nbin) - real(r8) :: dust_emis_fact = -1.e36_r8 ! tuning parameter for dust emissions - character(len=cl) :: soil_erod_file = 'soil_erod_file' ! full pathname for soil erodibility dataset + real(r8) :: dust_emis_fact = -1.e36_r8 ! tuning parameter for dust emissions + character(len=cl) :: soil_erod_file = 'none' ! full pathname for soil erodibility dataset + contains !============================================================================= @@ -44,8 +47,8 @@ module dust_model subroutine dust_readnl(nlfile) use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use mpishorthand + use spmd_utils, only: mpicom, masterprocid, mpi_character, mpi_real8, mpi_success + use shr_dust_emis_mod, only: shr_dust_emis_readnl character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -59,8 +62,7 @@ subroutine dust_readnl(nlfile) ! Read namelist if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) + open( newunit=unitn, file=trim(nlfile), status='old' ) call find_group_name(unitn, 'dust_nl', status=ierr) if (ierr == 0) then read(unitn, dust_nl, iostat=ierr) @@ -69,14 +71,34 @@ subroutine dust_readnl(nlfile) end if end if close(unitn) - call freeunit(unitn) end if -#ifdef SPMD ! Broadcast namelist variables - call mpibcast(dust_emis_fact, 1, mpir8, 0, mpicom) - call mpibcast(soil_erod_file, len(soil_erod_file), mpichar, 0, mpicom) -#endif + call mpi_bcast(soil_erod_file, len(soil_erod_file), mpi_character, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//' MPI_BCAST ERROR: soil_erod_file') + end if + call mpi_bcast(dust_emis_fact, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//' MPI_BCAST ERROR: dust_emis_fact') + end if + + call shr_dust_emis_readnl(mpicom, 'drv_flds_in') + + if ((soil_erod_file /= 'none') .and. (.not.is_zender_soil_erod_from_atm())) then + call endrun(subname//': should not specify soil_erod_file if Zender soil erosion is not in CAM') + end if + + if (masterproc) then + if (is_dust_emis_zender()) then + write(iulog,*) subname,': Zender_2003 dust emission method is being used.' + end if + if (is_zender_soil_erod_from_atm()) then + write(iulog,*) subname,': Zender soil erod file is handled in atm' + write(iulog,*) subname,': soil_erod_file = ',trim(soil_erod_file) + write(iulog,*) subname,': dust_emis_fact = ',dust_emis_fact + end if + end if end subroutine dust_readnl @@ -95,7 +117,9 @@ subroutine dust_init() dust_active = any(dust_indices(:) > 0) if (.not.dust_active) return - call soil_erod_init( dust_emis_fact, soil_erod_file ) + if (is_zender_soil_erod_from_atm()) then + call soil_erod_init( dust_emis_fact, soil_erod_file ) + endif call dust_set_params( dust_nbin, dust_dmt_grd, dust_dmt_vwr, dust_stk_crc ) @@ -106,6 +130,7 @@ end subroutine dust_init subroutine dust_emis( ncol, lchnk, dust_flux_in, cflx, soil_erod ) use soil_erod_mod, only : soil_erod_fact use soil_erod_mod, only : soil_erodibility + use cam_history_support, only : fillvalue ! args integer, intent(in) :: ncol, lchnk @@ -115,25 +140,44 @@ subroutine dust_emis( ncol, lchnk, dust_flux_in, cflx, soil_erod ) ! local vars integer :: i, m, idst + real(r8) :: erodfctr(ncol) real(r8), parameter :: dust_emis_sclfctr(dust_nbin) & = (/ 0.011_r8/0.032456_r8, 0.087_r8/0.174216_r8, 0.277_r8/0.4085517_r8, 0.625_r8/0.384811_r8 /) ! set dust emissions - col_loop: do i =1,ncol + if (is_zender_soil_erod_from_atm()) then + + col_loop1: do i =1,ncol + + soil_erod(i) = soil_erodibility( i, lchnk ) + + ! adjust emissions + do m = 1,dust_nbin + + idst = dust_indices(m) + cflx(i,idst) = -dust_flux_in(i,m) & + * dust_emis_sclfctr(m)*soil_erod(i)/dust_emis_fact*1.15_r8 - soil_erod(i) = soil_erodibility( i, lchnk ) + enddo - ! adjust emissions based on soil erosion - do m = 1,dust_nbin + end do col_loop1 - idst = dust_indices(m) - cflx(i,idst) = -dust_flux_in(i,m) & - * dust_emis_sclfctr(m)*soil_erod(i)/soil_erod_fact*1.15_r8 + else - enddo + col_loop2: do i =1,ncol - end do col_loop + ! adjust emissions + do m = 1,dust_nbin + + idst = dust_indices(m) + cflx(i,idst) = -dust_flux_in(i,m) * dust_emis_sclfctr(m) / dust_emis_fact + + enddo + + end do col_loop2 + + end if end subroutine dust_emis 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..0db4b9a21f 100644 --- a/src/chemistry/modal_aero/aero_model.F90 +++ b/src/chemistry/modal_aero/aero_model.F90 @@ -29,6 +29,7 @@ module aero_model use modal_aero_wateruptake, only: modal_strat_sulfate use mo_setsox, only: setsox, has_sox + use modal_aerosol_properties_mod, only: modal_aerosol_properties implicit none private @@ -45,9 +46,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,12 +102,14 @@ 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. logical :: convproc_do_aer + class(modal_aerosol_properties), pointer :: aero_props=>null() + contains !============================================================================= @@ -193,7 +197,7 @@ subroutine aero_model_init( pbuf2d ) use modal_aero_calcsize, only: modal_aero_calcsize_init use modal_aero_coag, only: modal_aero_coag_init - use modal_aero_deposition, only: modal_aero_deposition_init + use aero_deposition_cam, only: aero_deposition_cam_init use modal_aero_gasaerexch, only: modal_aero_gasaerexch_init use modal_aero_newnuc, only: modal_aero_newnuc_init use modal_aero_rename, only: modal_aero_rename_init @@ -252,10 +256,11 @@ subroutine aero_model_init( pbuf2d ) call modal_aero_coag_init call modal_aero_newnuc_init - ! call modal_aero_deposition_init only if the user has not specified + ! call aero_deposition_cam_init only if the user has not specified ! prescribed aerosol deposition fluxes if (.not.aerodep_flx_prescribed()) then - call modal_aero_deposition_init + aero_props => modal_aerosol_properties() + call aero_deposition_cam_init(aero_props) endif if (convproc_do_aer) then @@ -525,8 +530,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, ' ' ) @@ -680,7 +698,7 @@ subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, use modal_aero_data, only: numptrcw_amode use modal_aero_data, only: lmassptr_amode use modal_aero_data, only: lmassptrcw_amode - use modal_aero_deposition, only: set_srf_drydep + use aero_deposition_cam,only: aero_deposition_cam_setdry ! args type(physics_state), intent(in) :: state ! Physics state variables @@ -958,7 +976,7 @@ subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, ! 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 - call set_srf_drydep(aerdepdryis, aerdepdrycw, cam_out) + call aero_deposition_cam_setdry(aerdepdryis, aerdepdrycw, cam_out) endif endsubroutine aero_model_drydep @@ -967,12 +985,10 @@ subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, !============================================================================= 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 + use aero_deposition_cam, only: aero_deposition_cam_setwet ! args @@ -1076,20 +1092,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 +1111,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 +1126,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 +1152,35 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) stride_loop = -1 endif + if (convproc_do_aer) then + call t_startf('aero_model_wetdep:NAR: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('aero_model_wetdep:NAR: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 +1314,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 @@ -1299,6 +1324,7 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) qqcw_in(:,:) = fldcw(:,:) endif + call t_startf('aero_model_wetdep:NAR:wetdepa') call wetdepa_v2( state%pmid, state%q(:,:,1), state%pdel, & dep_inputs%cldt, dep_inputs%cldcu, dep_inputs%cmfdqr, & dep_inputs%evapc, dep_inputs%conicw, dep_inputs%prain, dep_inputs%qme, & @@ -1313,6 +1339,7 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) convproc_do_aer=convproc_do_aer, rcscavt=rcscavt, rsscavt=rsscavt, & sol_facti_in=sol_facti, sol_factic_in=sol_factic, & convproc_do_evaprain_atonce_in=convproc_do_evaprain_atonce ) + call t_stopf('aero_model_wetdep:NAR:wetdepa') do_hygro_sum_del = .false. if ( lspec > 0 ) do_hygro_sum_del = .true. @@ -1326,7 +1353,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 +1368,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 +1394,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 @@ -1528,6 +1555,7 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) fldcw => qqcw_get_field(pbuf, mm,lchnk) endif + call t_startf('aero_model_wetdep:NAR:wetdepa') call wetdepa_v2(state%pmid, state%q(:,:,1), state%pdel, & dep_inputs%cldt, dep_inputs%cldcu, dep_inputs%cmfdqr, & dep_inputs%evapc, dep_inputs%conicw, dep_inputs%prain, dep_inputs%qme, & @@ -1541,6 +1569,7 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) sol_facti_in=sol_facti, sol_factic_in=sol_factic, & convproc_do_evaprain_atonce_in=convproc_do_evaprain_atonce, & bergso_in=dep_inputs%bergso ) + call t_stopf('aero_model_wetdep:NAR:wetdepa') if(convproc_do_aer) then ! save resuspension of cloudborne species @@ -1611,46 +1640,10 @@ 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 - call set_srf_wetdep(aerdepwetis, aerdepwetcw, cam_out) + call aero_deposition_cam_setwet(aerdepwetis, aerdepwetcw, cam_out) endif endsubroutine aero_model_wetdep diff --git a/src/chemistry/modal_aero/dust_model.F90 b/src/chemistry/modal_aero/dust_model.F90 index 923ab9e3db..6213c47636 100644 --- a/src/chemistry/modal_aero/dust_model.F90 +++ b/src/chemistry/modal_aero/dust_model.F90 @@ -6,6 +6,8 @@ module dust_model use spmd_utils, only: masterproc use cam_abortutils, only: endrun use modal_aero_data, only: ntot_amode, ndst=>nDust + use cam_logfile, only: iulog + use shr_dust_emis_mod,only: is_dust_emis_zender, is_zender_soil_erod_from_atm implicit none private @@ -30,8 +32,8 @@ module dust_model real(r8), allocatable :: dust_dmt_vwr(:) real(r8), allocatable :: dust_stk_crc(:) - real(r8) :: dust_emis_fact = -1.e36_r8 ! tuning parameter for dust emissions - character(len=cl) :: soil_erod_file = 'soil_erod_file' ! full pathname for soil erodibility dataset + real(r8) :: dust_emis_fact = 0._r8 ! tuning parameter for dust emissions + character(len=cl) :: soil_erod_file = 'none' ! full pathname for soil erodibility dataset logical :: dust_active = .false. @@ -43,8 +45,8 @@ module dust_model subroutine dust_readnl(nlfile) use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use mpishorthand + use spmd_utils, only: mpicom, masterprocid, mpi_character, mpi_real8, mpi_success + use shr_dust_emis_mod, only: shr_dust_emis_readnl character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -58,8 +60,7 @@ subroutine dust_readnl(nlfile) ! Read namelist if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) + open( newunit=unitn, file=trim(nlfile), status='old' ) call find_group_name(unitn, 'dust_nl', status=ierr) if (ierr == 0) then read(unitn, dust_nl, iostat=ierr) @@ -68,14 +69,34 @@ subroutine dust_readnl(nlfile) end if end if close(unitn) - call freeunit(unitn) end if -#ifdef SPMD ! Broadcast namelist variables - call mpibcast(dust_emis_fact, 1, mpir8, 0, mpicom) - call mpibcast(soil_erod_file, len(soil_erod_file), mpichar, 0, mpicom) -#endif + call mpi_bcast(soil_erod_file, len(soil_erod_file), mpi_character, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//' MPI_BCAST ERROR: soil_erod_file') + end if + call mpi_bcast(dust_emis_fact, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//' MPI_BCAST ERROR: dust_emis_fact') + end if + + call shr_dust_emis_readnl(mpicom, 'drv_flds_in') + + if ((soil_erod_file /= 'none') .and. (.not.is_zender_soil_erod_from_atm())) then + call endrun(subname//': should not specify soil_erod_file if Zender soil erosion is not in CAM') + end if + + if (masterproc) then + if (is_dust_emis_zender()) then + write(iulog,*) subname,': Zender_2003 dust emission method is being used.' + end if + if (is_zender_soil_erod_from_atm()) then + write(iulog,*) subname,': Zender soil erod file is handled in atm' + write(iulog,*) subname,': soil_erod_file = ',trim(soil_erod_file) + write(iulog,*) subname,': dust_emis_fact = ',dust_emis_fact + end if + end if end subroutine dust_readnl @@ -131,7 +152,9 @@ subroutine dust_init() dust_active = any(dust_indices(:) > 0) if (.not.dust_active) return - call soil_erod_init( dust_emis_fact, soil_erod_file ) + if (is_zender_soil_erod_from_atm()) then + call soil_erod_init( dust_emis_fact, soil_erod_file ) + end if call dust_set_params( dust_nbin, dust_dmt_grd, dust_dmt_vwr, dust_stk_crc ) @@ -158,29 +181,36 @@ subroutine dust_emis( ncol, lchnk, dust_flux_in, cflx, soil_erod ) ! set dust emissions - col_loop: do i =1,ncol - - soil_erod(i) = soil_erodibility( i, lchnk ) - - if( soil_erod(i) .lt. soil_erod_threshold ) soil_erod(i) = 0._r8 - - ! rebin and adjust dust emissons.. - do m = 1,dust_nbin - - idst = dust_indices(m) - - cflx(i,idst) = sum( -dust_flux_in(i,:) ) & - * dust_emis_sclfctr(m)*soil_erod(i)/soil_erod_fact*1.15_r8 - - x_mton = 6._r8 / (pi * dust_density * (dust_dmt_vwr(m)**3._r8)) - - inum = dust_indices(m+dust_nbin) - - cflx(i,inum) = cflx(i,idst)*x_mton - - enddo - - end do col_loop + if (is_zender_soil_erod_from_atm()) then + col_loop1: do i = 1,ncol + soil_erod(i) = soil_erodibility( i, lchnk ) + if( soil_erod(i) .lt. soil_erod_threshold ) soil_erod(i) = 0._r8 + + ! rebin and adjust dust emissons. + do m = 1,dust_nbin + idst = dust_indices(m) + cflx(i,idst) = sum( -dust_flux_in(i,:) ) & + * dust_emis_sclfctr(m)*soil_erod(i)/dust_emis_fact*1.15_r8 + x_mton = 6._r8 / (pi * dust_density * (dust_dmt_vwr(m)**3._r8)) + inum = dust_indices(m+dust_nbin) + cflx(i,inum) = cflx(i,idst)*x_mton + enddo + enddo col_loop1 + else ! Leung emissions + + col_loop2: do i = 1,ncol + ! rebin and adjust dust emissons. + do m = 1,dust_nbin + idst = dust_indices(m) + + cflx(i,idst) = sum( -dust_flux_in(i,:) ) & + * dust_emis_sclfctr(m) / dust_emis_fact + x_mton = 6._r8 / (pi * dust_density * (dust_dmt_vwr(m)**3._r8)) + inum = dust_indices(m+dust_nbin) + cflx(i,inum) = cflx(i,idst)*x_mton + enddo + enddo col_loop2 + end if end subroutine dust_emis diff --git a/src/chemistry/modal_aero/modal_aero_convproc.F90 b/src/chemistry/modal_aero/modal_aero_convproc.F90 index 6c8b7cd441..9def684ec0 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') @@ -1094,8 +1098,9 @@ subroutine ma_convproc_tend( & real(r8) tmpmata(pcnst_extd,3) ! work variables real(r8) xinv_ntsub ! 1.0/ntsub real(r8) wup(pver) ! working updraft velocity (m/s) - 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) @@ -1135,6 +1140,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 +1168,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 @@ -1283,19 +1291,13 @@ subroutine ma_convproc_tend( & dtsub = dt*xinv_ntsub courantmax = courantmax*xinv_ntsub -! zmagl(k) = height above surface for middle of level k - zmagl(pver) = 0.0_r8 - do k = pver, 1, -1 - if (k < pver) then - zmagl(k) = zmagl(k+1) + 0.5_r8*dz - end if - dz = dp_i(k)*hund_ovr_g/rhoair_i(k) - zmagl(k) = zmagl(k) + 0.5_r8*dz - end do - ! 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) @@ -1434,6 +1436,7 @@ subroutine ma_convproc_tend( & ! compute lagrangian transport time (dt_u) and updraft fractional area (fa_u) ! *** these must obey dt_u(k)*mu_p_eudp(k) = dp_i(k)*fa_u(k) + dz = dp_i(k)*hund_ovr_g/rhoair_i(k) dt_u(k) = dz/wup(k) dt_u(k) = min( dt_u(k), dt ) fa_u(k) = dt_u(k)*(mu_p_eudp(k)/dp_i(k)) @@ -1547,6 +1550,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 +1618,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 +1782,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 +2125,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 +2242,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 +2275,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 @@ -2284,6 +2313,7 @@ subroutine accumulate_to_larger_mode( spc_name, lptr, prevap ) integer :: m,n, nl,ns + nl = -1 ! find constituent index of the largest mode for the species loop1: do m = 1,ntot_amode-1 nl = lptr(mode_size_order(m)) diff --git a/src/chemistry/modal_aero/modal_aero_rename.F90 b/src/chemistry/modal_aero/modal_aero_rename.F90 index 8a7d120f24..9ff3a2c87d 100644 --- a/src/chemistry/modal_aero/modal_aero_rename.F90 +++ b/src/chemistry/modal_aero/modal_aero_rename.F90 @@ -183,9 +183,6 @@ subroutine modal_aero_rename_sub( & real(r8), intent(inout) :: dqqcwdt(ncol,pver,pcnstxx) real(r8), intent(in) :: dqdt_other(ncol,pver,pcnstxx) ! tendencies for "other" continuous growth process - ! currently in cam3 - ! dqdt is from gas (h2so4, nh3) condensation - ! dqdt_other is from aqchem and soa ! *** NOTE ncol and pcnstxx dimensions real(r8), intent(in) :: dqqcwdt_other(ncol,pver,pcnstxx) logical, intent(inout) :: dotendrn(pcnstxx) ! identifies the species for which @@ -286,9 +283,6 @@ subroutine modal_aero_rename_no_acc_crs_sub( & real(r8), intent(inout) :: dqqcwdt(ncol,pver,pcnstxx) real(r8), intent(in) :: dqdt_other(ncol,pver,pcnstxx) ! tendencies for "other" continuous growth process - ! currently in cam3 - ! dqdt is from gas (h2so4, nh3) condensation - ! dqdt_other is from aqchem and soa ! *** NOTE ncol and pcnstxx dimensions real(r8), intent(in) :: dqqcwdt_other(ncol,pver,pcnstxx) logical, intent(inout) :: dotendrn(pcnstxx) ! identifies the species for which @@ -878,9 +872,6 @@ subroutine modal_aero_rename_acc_crs_sub( & real(r8), intent(inout) :: dqqcwdt(ncol,pver,pcnstxx) real(r8), intent(in) :: dqdt_other(ncol,pver,pcnstxx) ! tendencies for "other" continuous growth process - ! currently in cam3 - ! dqdt is from gas (h2so4, nh3) condensation - ! dqdt_other is from aqchem and soa ! *** NOTE ncol and pcnstxx dimensions real(r8), intent(in) :: dqqcwdt_other(ncol,pver,pcnstxx) logical, intent(inout) :: dotendrn(pcnstxx) ! identifies the species for which diff --git a/src/chemistry/mozart/chemistry.F90 b/src/chemistry/mozart/chemistry.F90 index 9c6396e262..40bc27cf6d 100644 --- a/src/chemistry/mozart/chemistry.F90 +++ b/src/chemistry/mozart/chemistry.F90 @@ -422,6 +422,8 @@ subroutine chem_readnl(nlfile) tracer_srcs_fixed_ymd_out = tracer_srcs_fixed_ymd, & tracer_srcs_fixed_tod_out = tracer_srcs_fixed_tod ) + drydep_srf_file = ' ' + if (masterproc) then unitn = getunit() open( unitn, file=trim(nlfile), status='old' ) diff --git a/src/chemistry/mozart/mo_drydep.F90 b/src/chemistry/mozart/mo_drydep.F90 index a44db8416e..06b87797c4 100644 --- a/src/chemistry/mozart/mo_drydep.F90 +++ b/src/chemistry/mozart/mo_drydep.F90 @@ -519,6 +519,16 @@ subroutine get_landuse_and_soilw_from_file() character(len=shr_kind_cl) :: locfn logical :: lexist + if (len_trim(drydep_srf_file) == 0) then + write(iulog,*)'**************************************' + write(iulog,*)' get_landuse_and_soilw_from_file: INFO:' + write(iulog,*)' drydep_srf_file not set:' + write(iulog,*)' setting fraction_landuse to zero' + write(iulog,*)'**************************************' + fraction_landuse = 0._r8 + return + end if + call getfil (drydep_srf_file, locfn, 1, lexist) if(lexist) then call cam_pio_openfile(piofile, locfn, PIO_NOWRITE) 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/chemistry/utils/prescribed_ozone.F90 b/src/chemistry/utils/prescribed_ozone.F90 index 92a4ac84b4..cc82603025 100644 --- a/src/chemistry/utils/prescribed_ozone.F90 +++ b/src/chemistry/utils/prescribed_ozone.F90 @@ -215,13 +215,8 @@ subroutine prescribed_ozone_adv( state, pbuf2d) if( .not. has_prescribed_ozone ) return - if( cam_physpkg_is('cam3') .and. aqua_planet ) then - molmass = 48._r8 - amass = 28.9644_r8 - else - molmass = 47.9981995_r8 - amass = mwdry - end if + molmass = 47.9981995_r8 + amass = mwdry call advance_trcdata( fields, file, state, pbuf2d ) diff --git a/src/control/cam_comp.F90 b/src/control/cam_comp.F90 index 9982df6d2c..a040762067 100644 --- a/src/control/cam_comp.F90 +++ b/src/control/cam_comp.F90 @@ -70,7 +70,6 @@ subroutine cam_init( & ! !----------------------------------------------------------------------- - use history_defaults, only: bldfld use cam_initfiles, only: cam_initfiles_open use dyn_grid, only: dyn_grid_init use phys_grid, only: phys_grid_init @@ -81,15 +80,12 @@ subroutine cam_init( & use stepon, only: stepon_init use ionosphere_interface, only: ionosphere_init use camsrfexch, only: hub2atm_alloc, atm2hub_alloc - use cam_history, only: intht - use history_scam, only: scm_intht + use cam_history, only: intht, write_camiop + use history_scam, only: scm_intht, initialize_iop_history use cam_pio_utils, only: init_pio_subsystem use cam_instance, only: inst_suffix use cam_snapshot_common, only: cam_snapshot_deactivate use air_composition, only: air_composition_init -#if (defined BFB_CAM_SCAM_IOP) - use history_defaults, only: initialize_iop_history -#endif use phys_grid_ctem, only: phys_grid_ctem_reg ! Arguments @@ -193,14 +189,11 @@ subroutine cam_init( & call cam_read_restart(cam_in, cam_out, dyn_in, dyn_out, pbuf2d, stop_ymd, stop_tod) -#if (defined BFB_CAM_SCAM_IOP) - call initialize_iop_history() -#endif end if - call phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) + if (write_camiop) call initialize_iop_history() - call bldfld () ! master field list (if branch, only does hash tables) + call phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) call stepon_init(dyn_in, dyn_out) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 28e1d848f2..39222fc536 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -182,6 +182,7 @@ module cam_history character(len=16) :: host ! host name character(len=8) :: inithist = 'YEARLY' ! If set to '6-HOURLY, 'DAILY', 'MONTHLY' or ! 'YEARLY' then write IC file + logical :: write_camiop = .false. ! setup to use iop fields if true. logical :: inithist_all = .false. ! Flag to indicate set of fields to be ! included on IC file ! .false. include only required fields @@ -317,8 +318,9 @@ module cam_history module procedure addfld_nd end interface - ! Needed by cam_diagnostics - public :: inithist_all + + public :: inithist_all ! Needed by cam_diagnostics + public :: write_camiop ! Needed by cam_comp integer :: lcltod_start(ptapes) ! start time of day for local time averaging (sec) integer :: lcltod_stop(ptapes) ! stop time of day for local time averaging, stop > start is wrap around (sec) @@ -852,25 +854,6 @@ subroutine history_readnl(nlfile) end do end if - ! Write out inithist info - if (masterproc) then - if (inithist == '6-HOURLY' ) then - write(iulog,*)'Initial conditions history files will be written 6-hourly.' - else if (inithist == 'DAILY' ) then - write(iulog,*)'Initial conditions history files will be written daily.' - else if (inithist == 'MONTHLY' ) then - write(iulog,*)'Initial conditions history files will be written monthly.' - else if (inithist == 'YEARLY' ) then - write(iulog,*)'Initial conditions history files will be written yearly.' - else if (inithist == 'CAMIOP' ) then - write(iulog,*)'Initial conditions history files will be written for IOP.' - else if (inithist == 'ENDOFRUN' ) then - write(iulog,*)'Initial conditions history files will be written at end of run.' - else - write(iulog,*)'Initial conditions history files will not be created' - end if - end if - ! Print out column-output information do t = 1, size(fincllonlat, 2) if (ANY(len_trim(fincllonlat(:,t)) > 0)) then @@ -916,6 +899,27 @@ subroutine history_readnl(nlfile) interpolate_info(t)%interp_nlon = interpolate_nlon(t) end do + ! Write out inithist info + if (masterproc) then + if (inithist == '6-HOURLY' ) then + write(iulog,*)'Initial conditions history files will be written 6-hourly.' + else if (inithist == 'DAILY' ) then + write(iulog,*)'Initial conditions history files will be written daily.' + else if (inithist == 'MONTHLY' ) then + write(iulog,*)'Initial conditions history files will be written monthly.' + else if (inithist == 'YEARLY' ) then + write(iulog,*)'Initial conditions history files will be written yearly.' + else if (inithist == 'CAMIOP' ) then + write(iulog,*)'Initial conditions history files will be written for IOP.' + else if (inithist == 'ENDOFRUN' ) then + write(iulog,*)'Initial conditions history files will be written at end of run.' + else + write(iulog,*)'Initial conditions history files will not be created' + end if + end if + if (inithist == 'CAMIOP') then + write_camiop=.true. + end if ! separate namelist reader for the satellite history file call sat_hist_readnl(nlfile, hfilename_spec, mfilt, fincl, nhtfrq, avgflag_pertape) @@ -4690,7 +4694,6 @@ subroutine h_define (t, restart) num_hdims = 2 do i = 1, num_hdims dimindex(i) = header_info(1)%get_hdimid(i) - nacsdims(i) = header_info(1)%get_hdimid(i) end do else if (patch_output) then ! All patches for this variable should be on the same grid @@ -4716,7 +4719,6 @@ subroutine h_define (t, restart) num_hdims = header_info(grd)%num_hdims() do i = 1, num_hdims dimindex(i) = header_info(grd)%get_hdimid(i) - nacsdims(i) = header_info(grd)%get_hdimid(i) end do end if ! is_satfile @@ -4832,22 +4834,8 @@ subroutine h_define (t, restart) tape(t)%hlist(fld)%field%name) call cam_pio_handle_error(ierr, & 'h_define: cannot define basename for '//trim(fname_tmp)) - end if - - if (restart) then - ! For restart history files, we need to save accumulation counts - fname_tmp = trim(fname_tmp)//'_nacs' - if (.not. associated(tape(t)%hlist(fld)%nacs_varid)) then - allocate(tape(t)%hlist(fld)%nacs_varid) - end if - if (size(tape(t)%hlist(fld)%nacs, 1) > 1) then - call cam_pio_def_var(tape(t)%Files(f), trim(fname_tmp), pio_int, & - nacsdims(1:num_hdims), tape(t)%hlist(fld)%nacs_varid) - else - ! Save just one value representing all chunks - call cam_pio_def_var(tape(t)%Files(f), trim(fname_tmp), pio_int, & - tape(t)%hlist(fld)%nacs_varid) - end if + end if + if(restart) then ! for standard deviation if (associated(tape(t)%hlist(fld)%sbuf)) then fname_tmp = strip_suffix(tape(t)%hlist(fld)%field%name) @@ -4858,9 +4846,69 @@ subroutine h_define (t, restart) call cam_pio_def_var(tape(t)%Files(f), trim(fname_tmp), pio_double, & dimids_tmp(1:fdims), tape(t)%hlist(fld)%sbuf_varid) endif - end if - end do ! Loop over output patches + endif + end do ! Loop over output patches end do ! Loop over fields + if (restart) then + do fld = 1, nflds(t) + if(is_satfile(t)) then + num_hdims=0 + nfils(t)=1 + else if (interpolate) then + ! Interpolate can't use normal grid code since we are forcing fields + ! to use interpolate decomp + if (.not. allocated(header_info)) then + ! Safety check + call endrun('h_define: header_info not allocated') + end if + num_hdims = 2 + do i = 1, num_hdims + nacsdims(i) = header_info(1)%get_hdimid(i) + end do + else if (patch_output) then + ! All patches for this variable should be on the same grid + num_hdims = tape(t)%patches(1)%num_hdims(tape(t)%hlist(fld)%field%decomp_type) + else + ! Normal grid output + ! Find appropriate grid in header_info + if (.not. allocated(header_info)) then + ! Safety check + call endrun('h_define: header_info not allocated') + end if + grd = -1 + do i = 1, size(header_info) + if (header_info(i)%get_gridid() == tape(t)%hlist(fld)%field%decomp_type) then + grd = i + exit + end if + end do + if (grd < 0) then + write(errormsg, '(a,i0,2a)') 'grid, ',tape(t)%hlist(fld)%field%decomp_type,', not found for ',trim(fname_tmp) + call endrun('H_DEFINE: '//errormsg) + end if + num_hdims = header_info(grd)%num_hdims() + do i = 1, num_hdims + nacsdims(i) = header_info(grd)%get_hdimid(i) + end do + end if ! is_satfile + + fname_tmp = strip_suffix(tape(t)%hlist(fld)%field%name) + ! For restart history files, we need to save accumulation counts + fname_tmp = trim(fname_tmp)//'_nacs' + if (.not. associated(tape(t)%hlist(fld)%nacs_varid)) then + allocate(tape(t)%hlist(fld)%nacs_varid) + end if + if (size(tape(t)%hlist(fld)%nacs, 1) > 1) then + call cam_pio_def_var(tape(t)%Files(f), trim(fname_tmp), pio_int, & + nacsdims(1:num_hdims), tape(t)%hlist(fld)%nacs_varid) + else + ! Save just one value representing all chunks + call cam_pio_def_var(tape(t)%Files(f), trim(fname_tmp), pio_int, & + tape(t)%hlist(fld)%nacs_varid) + end if + + end do ! Loop over fields + end if ! deallocate(mdimids) ret = pio_enddef(tape(t)%Files(f)) @@ -5516,6 +5564,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 +5578,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 +5631,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 +5639,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 +5660,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/cam_snapshot_common.F90 b/src/control/cam_snapshot_common.F90 index f2a4780619..61b27afeb0 100644 --- a/src/control/cam_snapshot_common.F90 +++ b/src/control/cam_snapshot_common.F90 @@ -48,7 +48,7 @@ module cam_snapshot_common ! This is the number of pbuf fields in the CAM code that are declared with the fieldname as opposed to being data driven. -integer, parameter :: npbuf_all = 327 +integer, parameter :: npbuf_all = 310 type snapshot_type character(len=40) :: ddt_string @@ -86,7 +86,7 @@ module cam_snapshot_common type (snapshot_type) :: tend_snapshot(6) type (snapshot_type) :: cam_in_snapshot(30) type (snapshot_type) :: cam_out_snapshot(30) -type (snapshot_type_nd) :: pbuf_snapshot(250) +type (snapshot_type_nd) :: pbuf_snapshot(300) contains @@ -1240,17 +1240,6 @@ subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) 'AurIPRateSum ','unset ',& 'awk_PBL ','unset ',& 'bprod ','unset ',& - 'cam3_bcphi ','unset ',& - 'cam3_bcpho ','unset ',& - 'cam3_dust1 ','unset ',& - 'cam3_dust2 ','unset ',& - 'cam3_dust3 ','unset ',& - 'cam3_dust4 ','unset ',& - 'cam3_ocphi ','unset ',& - 'cam3_ocpho ','unset ',& - 'cam3_ssam ','unset ',& - 'cam3_sscm ','unset ',& - 'cam3_sul ','unset ',& 'CC_ni ','unset ',& 'CC_nl ','unset ',& 'CC_qi ','unset ',& @@ -1325,9 +1314,7 @@ subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) 'delta_thl_PBL ','unset ',& 'delta_tr_PBL ','unset ',& 'delta_u_PBL ','unset ',& - 'delta_v_PBL ','unset '/) , (/2,100/)) - - pbuf_all(1:2,101:200) = reshape ( (/ & + 'delta_v_PBL ','unset ',& 'DES ','unset ',& 'DGNUM ','unset ',& 'DGNUMWET ','unset ',& @@ -1335,12 +1322,12 @@ subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) 'DLFZM ','kg/kg/s ',& 'DNIFZM ','1/kg/s ',& 'DNLFZM ','1/kg/s ',& - 'DP_CLDICE ','unset ',& - 'DP_CLDLIQ ','unset ',& 'DP_FLXPRC ','unset ',& 'DP_FLXSNW ','unset ',& 'DP_FRAC ','unset ',& - 'dragblj ','1/s ',& + 'dragblj ','1/s ' /), (/2,100/)) + + pbuf_all(1:2,101:200) = reshape ( (/ & 'DRYMASS ','unset ',& 'DRYRAD ','unset ',& 'DRYVOL ','unset ',& @@ -1427,9 +1414,7 @@ subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) 'QCWAT ','unset ',& 'QFLX ','kg/m2/s ',& 'QFLX_RES ','unset ',& - 'QINI ','unset ' /), (/2,100/)) - - pbuf_all(1:2,201:300) = reshape ( (/ & + 'QINI ','unset ',& 'qir_det ','kg/kg ',& 'QIST ','unset ',& 'qlr_det ','kg/kg ',& @@ -1442,7 +1427,9 @@ subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) 'QRS ','K/s ',& 'qrsin ','unset ',& 'QSATFAC ','- ',& - 'QSNOW ','kg/kg ',& + 'QSNOW ','kg/kg ' /), (/2,100/)) + + pbuf_all(1:2,201:300) = reshape ( (/ & 'QTeAur ','unset ',& 'qti_flx ','unset ',& 'qtl_flx ','unset ',& @@ -1470,9 +1457,7 @@ subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) 'SD ','unset ',& 'SGH30 ','unset ',& 'SGH ','unset ',& - 'SH_CLDICE1 ','unset ',& 'SH_CLDICE ','unset ',& - 'SH_CLDLIQ1 ','unset ',& 'SH_CLDLIQ ','unset ',& 'SH_E_ED_RATIO ','unset ',& 'SHFLX ','W/m2 ',& @@ -1481,7 +1466,6 @@ subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) 'SH_FLXSNW ','unset ',& 'SH_FRAC ','unset ',& 'shfrc ','unset ',& - 'smaw ','unset ',& 'SNOW_DP ','unset ',& 'SNOW_PCW ','unset ',& 'SNOW_SED ','unset ',& @@ -1523,15 +1507,12 @@ subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) 'TTEND_DP ','unset ',& 'TTEND_SH ','unset ',& 'T_TTEND ','unset ',& - 'turbtype ','unset ',& "UI ",'m/s ',& 'UM ','unset ',& 'UP2_nadv ','unset ',& 'UPWP ','m^2/s^2 ',& 'UZM ','M/S ',& - 'VI ','m/s ' /), (/2,100/)) - - pbuf_all(1:2,301:npbuf_all) = reshape ( (/ & + 'VI ','m/s ',& 'VM ','m/s ',& 'VOLC_MMR ','unset ',& 'VOLC_RAD_GEOM ','unset ',& @@ -1548,7 +1529,9 @@ subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) 'WPTHVP ','unset ',& 'WSEDL ','unset ',& 'wstarPBL ','unset ',& - 'ZM_DP ','unset ',& + 'ZM_DP ','unset ' /), (/2,100/)) + + pbuf_all(1:2,301:npbuf_all) = reshape ( (/ & 'ZM_DSUBCLD ','unset ',& 'ZM_DU ','unset ',& 'ZM_ED ','unset ',& @@ -1558,7 +1541,7 @@ subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) 'ZM_MAXG ','unset ',& 'ZM_MD ','unset ',& 'ZM_MU ','unset ',& - 'ZTODT ','unset ' /), (/2,27/)) + 'ZTODT ','unset ' /), (/2,10/)) ! Fields which are added with pbuf_add_field calls, but are data driven. These are not ! included in the above list. This means that these fields will not have proper units 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/dynamics/eul/getinterpnetcdfdata.F90 b/src/control/getinterpnetcdfdata.F90 similarity index 85% rename from src/dynamics/eul/getinterpnetcdfdata.F90 rename to src/control/getinterpnetcdfdata.F90 index a86ae52621..536d72d5de 100644 --- a/src/dynamics/eul/getinterpnetcdfdata.F90 +++ b/src/control/getinterpnetcdfdata.F90 @@ -3,13 +3,12 @@ module getinterpnetcdfdata ! Description: ! Routines for extracting a column from a netcdf file ! -! Author: -! +! Author: +! ! Modules Used: ! use cam_abortutils, only: endrun use pmgrid, only: plev - use scamMod, only: scm_crm_mode use cam_logfile, only: iulog implicit none @@ -22,10 +21,10 @@ module getinterpnetcdfdata contains subroutine getinterpncdata( NCID, camlat, camlon, TimeIdx, & - varName, have_surfdat, surfdat, fill_ends, & - press, npress, ps, outData, STATUS ) + varName, have_surfdat, surfdat, fill_ends, scm_crm_mode, & + press, npress, ps, hyam, hybm, outData, STATUS ) -! getinterpncdata: extracts the entire level dimension for a +! getinterpncdata: extracts the entire level dimension for a ! particular lat,lon,time from a netCDF file ! and interpolates it onto the input pressure levels, placing ! result in outData, and the error status inx STATUS @@ -41,12 +40,15 @@ subroutine getinterpncdata( NCID, camlat, camlon, TimeIdx, & integer, intent(in) :: NCID ! NetCDF ID integer, intent(in) :: TimeIdx ! time index - real(r8), intent(in) :: camlat,camlon ! target lat and lon to be extracted + real(r8), intent(in) :: camlat,camlon ! target lat and lon to be extracted logical, intent(in) :: have_surfdat ! is surfdat provided - logical, intent(in) :: fill_ends ! extrapolate the end values + logical, intent(in) :: fill_ends ! extrapolate the end values + logical, intent(in) :: scm_crm_mode ! scam column radiation mode integer, intent(in) :: npress ! number of dataset pressure levels real(r8), intent(in) :: press(npress) ! dataset pressure levels - real(r8), intent(in) :: ps ! dataset pressure levels + real(r8), intent(in) :: ps ! surface pressure + real(r8), intent(in) :: hyam(:) ! dataset hybrid midpoint pressure levels + real(r8), intent(in) :: hybm(:) ! dataset hybrid midpoint pressure levels ! ---------- outputs ---------- @@ -67,7 +69,7 @@ subroutine getinterpncdata( NCID, camlat, camlon, TimeIdx, & integer dims_set integer i integer var_dimIDs( NF90_MAX_VAR_DIMS ) - integer start( NF90_MAX_VAR_DIMS ) + integer start( NF90_MAX_VAR_DIMS ) integer count( NF90_MAX_VAR_DIMS ) character varName*(*) @@ -115,9 +117,9 @@ subroutine getinterpncdata( NCID, camlat, camlon, TimeIdx, & write(iulog,* ) 'ERROR - extractdata.F:Cant get dimension IDs for', varName return endif -! -! Initialize the start and count arrays -! +! +! Initialize the start and count arrays +! dims_set = 0 nlev = 1 do i = var_ndims, 1, -1 @@ -127,12 +129,12 @@ subroutine getinterpncdata( NCID, camlat, camlon, TimeIdx, & if ( dim_name .EQ. 'lat' ) then start( i ) = latIdx - count( i ) = 1 ! Extract a single value + count( i ) = 1 ! Extract a single value dims_set = dims_set + 1 usable_var = .true. endif - if ( dim_name .EQ. 'lon' ) then + if ( dim_name .EQ. 'lon' .or. dim_name .EQ. 'ncol' .or. dim_name .EQ. 'ncol_d' ) then start( i ) = lonIdx count( i ) = 1 ! Extract a single value dims_set = dims_set + 1 @@ -155,10 +157,10 @@ subroutine getinterpncdata( NCID, camlat, camlon, TimeIdx, & usable_var = .true. endif - if ( dim_name .EQ. 'time' .OR. dim_name .EQ. 'tsec' ) then + if ( dim_name .EQ. 'time' .OR. dim_name .EQ. 'tsec' ) then start( i ) = TimeIdx - count( i ) = 1 ! Extract a single value - dims_set = dims_set + 1 + count( i ) = 1 ! Extract a single value + dims_set = dims_set + 1 usable_var = .true. endif @@ -187,11 +189,11 @@ subroutine getinterpncdata( NCID, camlat, camlon, TimeIdx, & if ( nlev .eq. 1 ) then outdata(1) = tmp(1) - return ! no need to do interpolation + return ! no need to do interpolation endif ! if ( use_camiop .and. nlev.eq.plev) then if ( nlev.eq.plev .or. nlev.eq.plev+1) then - outData(:nlev)= tmp(:nlev)! no need to do interpolation + outData(:nlev)= tmp(:nlev)! no need to do interpolation else ! ! add the surface data if available, else @@ -224,7 +226,7 @@ subroutine getinterpncdata( NCID, camlat, camlon, TimeIdx, & endif ! ! reset status to zero -! +! STATUS = 0 ! do i=1, npress @@ -236,7 +238,7 @@ subroutine getinterpncdata( NCID, camlat, camlon, TimeIdx, & enddo #endif ! - call interplevs( tmp(:npress), press, npress, ps, fill_ends,outdata ) + call interplevs( tmp(:npress), press, npress, ps, fill_ends, hyam, hybm, outdata ) endif @@ -245,10 +247,9 @@ subroutine getinterpncdata( NCID, camlat, camlon, TimeIdx, & end subroutine getinterpncdata subroutine interplevs( inputdata, dplevs, nlev, & - ps, fill_ends, outdata) + ps, fill_ends, hyam, hybm, outdata) use shr_kind_mod, only: r8 => shr_kind_r8, i8 => shr_kind_i8 - use hycoef, only: hyam, hybm use interpolate_data, only: lininterp implicit none @@ -264,12 +265,14 @@ subroutine interplevs( inputdata, dplevs, nlev, & ! ------- inputs ----------- integer, intent(in) :: nlev ! num press levels in dataset - real(r8), intent(in) :: ps ! surface pressure + real(r8), intent(in) :: ps ! surface pressure + real(r8), intent(in) :: hyam(:) ! a midpoint pressure + real(r8), intent(in) :: hybm(:) ! b midpoint pressure real(r8), intent(in) :: inputdata(nlev) ! data from netcdf dataset - real(r8), intent(in) :: dplevs(nlev) ! input data pressure levels + real(r8), intent(in) :: dplevs(nlev) ! input data pressure levels logical, intent(in) :: fill_ends ! fill in missing end values(used for - ! global model datasets) + ! global model datasets) ! ------- outputs ---------- @@ -281,7 +284,7 @@ subroutine interplevs( inputdata, dplevs, nlev, & real(r8) interpdata( PLEV ) - integer dstart_lev, dend_lev + integer dstart_lev, dend_lev integer mstart_lev, mend_lev integer data_nlevs, model_nlevs, i integer STATUS @@ -293,14 +296,14 @@ subroutine interplevs( inputdata, dplevs, nlev, & do i = 1, plev mplevs( i ) = 1000.0_r8 * hyam( i ) + ps * hybm( i ) / 100.0_r8 end do -! +! ! the following algorithm assumes that pressures are increasing in the ! arrays -! -! +! +! ! Find the data pressure levels that are just outside the range ! of the model pressure levels, and that contain valid values -! +! dstart_lev = 1 do i= 1, nlev if ( dplevs(i) .LE. mplevs(1) ) dstart_lev = i @@ -312,7 +315,7 @@ subroutine interplevs( inputdata, dplevs, nlev, & dend_lev = i endif end do -! +! ! Find the model pressure levels that are just inside the range ! of the data pressure levels ! @@ -340,10 +343,10 @@ subroutine interplevs( inputdata, dplevs, nlev, & outdata( i+mstart_lev-1 ) = interpdata( i ) end do ! -! fill in the missing end values +! fill in the missing end values ! (usually done if this is global model dataset) ! - if ( fill_ends ) then + if ( fill_ends ) then do i=1, mstart_lev outdata(i) = inputdata(1) end do @@ -355,4 +358,3 @@ subroutine interplevs( inputdata, dplevs, nlev, & return end subroutine interplevs end module getinterpnetcdfdata - diff --git a/src/control/history_defaults.F90 b/src/control/history_defaults.F90 deleted file mode 100644 index 73e5554e14..0000000000 --- a/src/control/history_defaults.F90 +++ /dev/null @@ -1,143 +0,0 @@ -module history_defaults -!----------------------------------------------------------------------- -! -! Purpose: contains calls to setup default history stuff that has not found -! a proper home yet. Shouldn't really exist. -! -! Public functions/subroutines: -! bldfld -! -! Author: B.A. Boville from code in cam_history.F90 -!----------------------------------------------------------------------- - use constituents, only: pcnst, cnst_name - - use cam_history, only: addfld, add_default, horiz_only - implicit none - - PRIVATE - - public :: bldfld - -#if ( defined BFB_CAM_SCAM_IOP ) - public :: initialize_iop_history -#endif - -CONTAINS - - -!####################################################################### - subroutine bldfld () -! -!----------------------------------------------------------------------- -! -! Purpose: -! -! Build Master Field List of all possible fields in a history file. Each field has -! associated with it a "long_name" netcdf attribute that describes what the field is, -! and a "units" attribute. -! -! Method: Call a subroutine to add each field -! -! Author: CCM Core Group -! -!----------------------------------------------------------------------- -! -! Local workspace -! - integer m ! Index - -!jt -!jt Maybe add this to scam specific initialization -!jt - -#if ( defined BFB_CAM_SCAM_IOP ) - call addfld ('CLAT1&IC', horiz_only, 'I', ' ','cos lat for bfb testing', gridname='gauss_grid') - call add_default ('CLAT1&IC',0,'I') - call addfld ('CLON1&IC', horiz_only, 'I', ' ','cos lon for bfb testing', gridname='gauss_grid') - call add_default ('CLON1&IC',0,'I') - call addfld ('PHI&IC', horiz_only, 'I', ' ','lat for bfb testing', gridname='gauss_grid') - call add_default ('PHI&IC',0, 'I') - call addfld ('LAM&IC', horiz_only, 'I', ' ','lon for bfb testing', gridname='gauss_grid') - call add_default ('LAM&IC',0, 'I') -#endif - - call addfld ('DQP', (/ 'lev' /), 'A', 'kg/kg/s','Specific humidity tendency due to precipitation', & - gridname='physgrid') - - end subroutine bldfld - -!####################################################################### -#if ( defined BFB_CAM_SCAM_IOP ) - subroutine initialize_iop_history() -! -! !DESCRIPTION: -! !USES: - use iop - use phys_control, only: phys_getopts -! !ARGUMENTS: - implicit none -! -! !CALLED FROM: -! -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer m -!----------------------------------------------------------------------- - call addfld ('CLAT', horiz_only, 'A', ' ', 'cos lat for bfb testing', gridname='gauss_grid') - call add_default ('CLAT',2,' ') - call addfld ('q', (/ 'lev' /), 'A', 'kg/kg', 'Q for scam',gridname='gauss_grid') - call add_default ('q',2, ' ') - call addfld ('u', (/ 'lev' /), 'A', 'm/s', 'U for scam',gridname='gauss_grid') - call add_default ('u',2,' ') - call addfld ('v', (/ 'lev' /), 'A', 'm/s', 'V for scam',gridname='gauss_grid') - call add_default ('v',2,' ') - call addfld ('t', (/ 'lev' /), 'A', 'K', 'Temperature for scam',gridname='gauss_grid') - call add_default ('t',2,' ') - call addfld ('Tg', horiz_only, 'A', 'K', 'Surface temperature (radiative) for scam',gridname='physgrid') - call add_default ('Tg',2,' ') - call addfld ('Ps', horiz_only, 'A', 'Pa', 'Ps for scam',gridname='gauss_grid') - call add_default ('Ps',2,' ') - call addfld ('divT3d', (/ 'lev' /), 'A', 'K', 'Dynamics Residual for T',gridname='gauss_grid') - call add_default ('divT3d',2,' ') - call addfld ('divU3d', (/ 'lev' /), 'A', 'K', 'Dynamics Residual for U',gridname='gauss_grid') - call add_default ('divU3d',2,' ') - call addfld ('divV3d', (/ 'lev' /), 'A', 'K', 'Dynamics Residual for V',gridname='gauss_grid') - call add_default ('divV3d',2,' ') - call addfld ('fixmas', horiz_only, 'A', 'percent','Mass fixer',gridname='gauss_grid') - call add_default ('fixmas',2,' ') - call addfld ('beta', horiz_only, 'A', 'percent','Mass fixer',gridname='gauss_grid') - call add_default ('beta',2,' ') - do m=1,pcnst - call addfld (trim(cnst_name(m))//'_dten', (/ 'lev' /), 'A', 'kg/kg', & - trim(cnst_name(m))//' IOP Dynamics Residual for '//trim(cnst_name(m)),gridname='gauss_grid') - call add_default (trim(cnst_name(m))//'_dten',2,' ') - call addfld (trim(cnst_name(m))//'_alph', horiz_only, 'A', 'kg/kg',trim(cnst_name(m))//' alpha constituent fixer', & - gridname='gauss_grid') - call add_default (trim(cnst_name(m))//'_alph',2,' ') - call addfld (trim(cnst_name(m))//'_dqfx', (/ 'lev' /), 'A', 'kg/kg',trim(cnst_name(m))//' dqfx3 fixer', & - gridname='gauss_grid') - call add_default (trim(cnst_name(m))//'_dqfx',2,' ') - end do - call addfld ('shflx', horiz_only, 'A', 'W/m2', 'Surface sensible heat flux for scam',gridname='physgrid') - call add_default ('shflx',2,' ') - call addfld ('lhflx', horiz_only, 'A', 'W/m2', 'Surface latent heat flux for scam',gridname='physgrid') - call add_default ('lhflx',2,' ') - call addfld ('trefht', horiz_only, 'A', 'K', 'Reference height temperature',gridname='physgrid') - call add_default ('trefht',2,' ') - call addfld ('Tsair', horiz_only, 'A', 'K', 'Reference height temperature for scam',gridname='physgrid') - call add_default ('Tsair',2,' ') - call addfld ('phis', horiz_only, 'I', 'm2/s2','Surface geopotential for scam',gridname='physgrid') - call add_default ('phis',2,' ') - call addfld ('Prec', horiz_only, 'A', 'm/s', 'Total (convective and large-scale) precipitation rate for scam', & - gridname='physgrid') - call add_default ('Prec',2,' ') - call addfld ('omega', (/ 'lev' /), 'A', 'Pa/s', 'Vertical velocity (pressure)',gridname='physgrid') - call add_default ('omega',2,' ') - - end subroutine initialize_iop_history -#endif - -end module history_defaults diff --git a/src/control/history_scam.F90 b/src/control/history_scam.F90 index 2c81ce1a78..e171fcee96 100644 --- a/src/control/history_scam.F90 +++ b/src/control/history_scam.F90 @@ -1,106 +1,219 @@ module history_scam -!----------------------------------------------------------------------- -! +!----------------------------------------------------------------------- +! ! Purpose: SCAM specific history code. ! ! Public functions/subroutines: ! bldfld, h_default -! +! ! Author: anonymous from code in cam_history.F90 !----------------------------------------------------------------------- use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_history, only: addfld, add_default, horiz_only + use cam_grid_support, only: max_hcoordname_len implicit none PRIVATE public :: scm_intht + public :: initialize_iop_history !####################################################################### CONTAINS subroutine scm_intht() -!----------------------------------------------------------------------- -! -! Purpose: +!----------------------------------------------------------------------- +! +! Purpose: ! ! add master list fields to scm -! +! ! Method: Call a subroutine to add each field -! +! ! Author: CCM Core Group -! +! !----------------------------------------------------------------------- - use cam_history, only: addfld, add_default, horiz_only + use dycore, only: dycore_is + use cam_history, only: write_camiop !----------------------------------------------------------------------- ! !----------------------------------------------------------------------- ! Local variables ! - integer m,j ! Indices - real(r8) dummy + character(len=max_hcoordname_len) outgrid + + if (dycore_is('SE')) then + ! for camiop mode use the GLL grid otherwise use physics grids for SCM mode output + if (write_camiop) then + outgrid = 'GLL' + else + outgrid = 'physgrid' + end if + else if (dycore_is('EUL')) then + outgrid = 'gauss_grid' + else + outgrid = 'unknown' + end if ! ! Call addfld to add each field to the Master Field List. ! - call addfld ('TDIFF', (/ 'lev' /), 'A', 'K','difference from observed temp', gridname='gauss_grid') - call addfld ('UDIFF', (/ 'lev' /), 'A', 'K','difference from observed u wind', gridname='gauss_grid') - call addfld ('VDIFF', (/ 'lev' /), 'A', 'K','difference from observed v wind', gridname='gauss_grid') + call addfld ('TDIFF', (/ 'lev' /), 'A', 'K','difference from observed temp', gridname=trim(outgrid)) + call addfld ('UDIFF', (/ 'lev' /), 'A', 'K','difference from observed u wind', gridname=trim(outgrid)) + call addfld ('VDIFF', (/ 'lev' /), 'A', 'K','difference from observed v wind', gridname=trim(outgrid)) call addfld ('TOBS', (/ 'lev' /), 'A', 'K','observed temp') - call addfld ('QDIFF', (/ 'lev' /), 'A', 'kg/kg','difference from observed water', gridname='gauss_grid') + call addfld ('QDIFF', (/ 'lev' /), 'A', 'kg/kg','difference from observed water', gridname=trim(outgrid)) call addfld ('QOBS', (/ 'lev' /), 'A', 'kg/kg','observed water', gridname='physgrid') call addfld ('PRECOBS', (/ 'lev' /), 'A', 'mm/day','Total (convective and large-scale) precipitation rate', & gridname='physgrid') call addfld ('DIVQ', (/ 'lev' /), 'A', 'kg/kg/s','Q advection tendency (horizontal)', gridname='physgrid') - call addfld ('DIVQ3D', (/ 'lev' /), 'A', 'kg/kg/s','Q advection tendency (horiz/vert combined)', gridname='gauss_grid') + call addfld ('DIVQ3D', (/ 'lev' /), 'A', 'kg/kg/s','Q advection tendency (horiz/vert combined)', gridname=trim(outgrid)) call addfld ('DIVV', (/ 'lev' /), 'A', 'm/s2','V advection tendency (horizontal)', gridname='physgrid') call addfld ('DIVU', (/ 'lev' /), 'A', 'm/s2','U advection tendency (horizontal)', gridname='physgrid') call addfld ('DIVT', (/ 'lev' /), 'A', 'K/s','T advection tendency (horizontal)', gridname='physgrid') - call addfld ('DIVT3D', (/ 'lev' /), 'A', 'K/s','T advection tendency (horiz/vert combined)', gridname='gauss_grid') - call addfld ('DIVU3D', (/ 'lev' /), 'A', 'K/s','U advection tendency (horiz/vert combined)', gridname='gauss_grid') - call addfld ('DIVV3D', (/ 'lev' /), 'A', 'K/s','V advection tendency (horiz/vert combined)', gridname='gauss_grid') + call addfld ('DIVT3D', (/ 'lev' /), 'A', 'K/s','T advection tendency (horiz/vert combined)', gridname=trim(outgrid)) + call addfld ('DIVU3D', (/ 'lev' /), 'A', 'K/s','U advection tendency (horiz/vert combined)', gridname=trim(outgrid)) + call addfld ('DIVV3D', (/ 'lev' /), 'A', 'K/s','V advection tendency (horiz/vert combined)', gridname=trim(outgrid)) call addfld ('SHFLXOBS', horiz_only, 'A', 'W/m2','Obs Surface sensible heat flux', gridname='physgrid') call addfld ('LHFLXOBS', horiz_only, 'A', 'W/m2','Obs Surface latent heat flux', gridname='physgrid') - call addfld ('TRELAX', (/ 'lev' /), 'A', 'K','t relaxation amount', gridname='gauss_grid') - call addfld ('QRELAX', (/ 'lev' /), 'A', 'kg/kg','q relaxation amount', gridname='gauss_grid') - call addfld ('TAURELAX', (/ 'lev' /), 'A', 'seconds','relaxation time constant', gridname='gauss_grid') + call addfld ('TRELAX', (/ 'lev' /), 'A', 'K','t relaxation amount', gridname=trim(outgrid)) + call addfld ('QRELAX', (/ 'lev' /), 'A', 'kg/kg','q relaxation amount', gridname=trim(outgrid)) + call addfld ('TAURELAX', (/ 'lev' /), 'A', 'seconds','relaxation time constant', gridname=trim(outgrid)) call add_default ('TDIFF', 1, ' ') call add_default ('QDIFF', 1, ' ') ! Vertical advective forcing of 'T,u,v,qv,ql,qi,nl,ni' in forecast.F90 - call addfld ('TTEN_XYADV', (/ 'lev' /), 'I', 'K/s', 'T horizontal advective forcing', gridname='gauss_grid' ) - call addfld ('UTEN_XYADV', (/ 'lev' /), 'I', 'm/s^2', 'U horizontal advective forcing', gridname='gauss_grid' ) - call addfld ('VTEN_XYADV', (/ 'lev' /), 'I', 'm/s^2', 'V horizontal advective forcing', gridname='gauss_grid' ) - call addfld ('QVTEN_XYADV', (/ 'lev' /), 'I', 'kg/kg/s','QV horizontal advective forcing', gridname='gauss_grid' ) - call addfld ('QLTEN_XYADV', (/ 'lev' /), 'I', 'kg/kg/s','QL horizontal advective forcing', gridname='gauss_grid' ) - call addfld ('QITEN_XYADV', (/ 'lev' /), 'I', 'kg/kg/s','QI horizontal advective forcing', gridname='gauss_grid' ) - call addfld ('NLTEN_XYADV', (/ 'lev' /), 'I', '#/kg/s', 'NL horizontal advective forcing', gridname='gauss_grid' ) - call addfld ('NITEN_XYADV', (/ 'lev' /), 'I', '#/kg/s', 'NI horizontal advective forcing', gridname='gauss_grid' ) - -! call addfld ('T3D_ADV_SLT', 'K/s' , pver, 'I', 'T 3d slt advective forcing', gridname='physgrid') -! call addfld ('U3D_ADV_SLT', 'm/s^2' , pver, 'I', 'U 3d slt advective forcing', gridname='physgrid') -! call addfld ('V3D_ADV_SLT', 'm/s^2' , pver, 'I', 'V 3d slt advective forcing', gridname='physgrid') - call addfld ('TTEN_ZADV', (/ 'lev' /), 'I', 'K/s', 'T vertical advective forcing', gridname='gauss_grid' ) - call addfld ('UTEN_ZADV', (/ 'lev' /), 'I', 'm/s^2', 'U vertical advective forcing', gridname='gauss_grid' ) - call addfld ('VTEN_ZADV', (/ 'lev' /), 'I', 'm/s^2', 'V vertical advective forcing', gridname='gauss_grid' ) - call addfld ('QVTEN_ZADV', (/ 'lev' /), 'I', 'kg/kg/s','QV vertical advective forcing', gridname='gauss_grid' ) - call addfld ('QLTEN_ZADV', (/ 'lev' /), 'I', 'kg/kg/s','QL vertical advective forcing', gridname='gauss_grid' ) - call addfld ('QITEN_ZADV', (/ 'lev' /), 'I', 'kg/kg/s','QI vertical advective forcing', gridname='gauss_grid' ) - call addfld ('NLTEN_ZADV', (/ 'lev' /), 'I', '#/kg/s', 'NL vertical advective forcing', gridname='gauss_grid' ) - call addfld ('NITEN_ZADV', (/ 'lev' /), 'I', '#/kg/s', 'NI vertical advective forcing', gridname='gauss_grid' ) - - call addfld ('TTEN_PHYS', (/ 'lev' /), 'I', 'K/s', 'T vertical advective forcing', gridname='gauss_grid' ) - call addfld ('UTEN_PHYS', (/ 'lev' /), 'I', 'm/s^2', 'U vertical advective forcing', gridname='gauss_grid' ) - call addfld ('VTEN_PHYS', (/ 'lev' /), 'I', 'm/s^2', 'V vertical advective forcing', gridname='gauss_grid' ) - call addfld ('QVTEN_PHYS', (/ 'lev' /), 'I','kg/kg/s','QV vertical advective forcing', gridname='gauss_grid' ) - call addfld ('QLTEN_PHYS', (/ 'lev' /), 'I','kg/kg/s','QL vertical advective forcing', gridname='gauss_grid' ) - call addfld ('QITEN_PHYS', (/ 'lev' /), 'I','kg/kg/s','QI vertical advective forcing', gridname='gauss_grid' ) - call addfld ('NLTEN_PHYS', (/ 'lev' /), 'I','#/kg/s', 'NL vertical advective forcing', gridname='gauss_grid' ) - call addfld ('NITEN_PHYS', (/ 'lev' /), 'I','#/kg/s', 'NI vertical advective forcing', gridname='gauss_grid' ) + call addfld ('TTEN_XYADV', (/ 'lev' /), 'I', 'K/s', 'T horizontal advective forcing', gridname=trim(outgrid) ) + call addfld ('UTEN_XYADV', (/ 'lev' /), 'I', 'm/s^2', 'U horizontal advective forcing', gridname=trim(outgrid) ) + call addfld ('VTEN_XYADV', (/ 'lev' /), 'I', 'm/s^2', 'V horizontal advective forcing', gridname=trim(outgrid) ) + call addfld ('QVTEN_XYADV', (/ 'lev' /), 'I', 'kg/kg/s','QV horizontal advective forcing', gridname=trim(outgrid) ) + call addfld ('QLTEN_XYADV', (/ 'lev' /), 'I', 'kg/kg/s','QL horizontal advective forcing', gridname=trim(outgrid) ) + call addfld ('QITEN_XYADV', (/ 'lev' /), 'I', 'kg/kg/s','QI horizontal advective forcing', gridname=trim(outgrid) ) + call addfld ('NLTEN_XYADV', (/ 'lev' /), 'I', '#/kg/s', 'NL horizontal advective forcing', gridname=trim(outgrid) ) + call addfld ('NITEN_XYADV', (/ 'lev' /), 'I', '#/kg/s', 'NI horizontal advective forcing', gridname=trim(outgrid) ) + + call addfld ('TTEN_ZADV', (/ 'lev' /), 'I', 'K/s', 'T vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('UTEN_ZADV', (/ 'lev' /), 'I', 'm/s^2', 'U vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('VTEN_ZADV', (/ 'lev' /), 'I', 'm/s^2', 'V vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('QVTEN_ZADV', (/ 'lev' /), 'I', 'kg/kg/s','QV vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('QLTEN_ZADV', (/ 'lev' /), 'I', 'kg/kg/s','QL vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('QITEN_ZADV', (/ 'lev' /), 'I', 'kg/kg/s','QI vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('NLTEN_ZADV', (/ 'lev' /), 'I', '#/kg/s', 'NL vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('NITEN_ZADV', (/ 'lev' /), 'I', '#/kg/s', 'NI vertical advective forcing', gridname=trim(outgrid) ) + + call addfld ('TTEN_PHYS', (/ 'lev' /), 'I', 'K/s', 'T vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('UTEN_PHYS', (/ 'lev' /), 'I', 'm/s^2', 'U vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('VTEN_PHYS', (/ 'lev' /), 'I', 'm/s^2', 'V vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('QVTEN_PHYS', (/ 'lev' /), 'I','kg/kg/s','QV vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('QLTEN_PHYS', (/ 'lev' /), 'I','kg/kg/s','QL vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('QITEN_PHYS', (/ 'lev' /), 'I','kg/kg/s','QI vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('NLTEN_PHYS', (/ 'lev' /), 'I','#/kg/s', 'NL vertical advective forcing', gridname=trim(outgrid) ) + call addfld ('NITEN_PHYS', (/ 'lev' /), 'I','#/kg/s', 'NI vertical advective forcing', gridname=trim(outgrid) ) end subroutine scm_intht +!####################################################################### + subroutine initialize_iop_history() +!----------------------------------------------------------------------- +! +! Purpose: Add fields and set defaults for SCAM CAM BFB IOP initial file +! as well as single column output history +! +! Method: Call a subroutine to add each field +! +!----------------------------------------------------------------------- +! +! !USES: + use constituents, only: pcnst, cnst_name + use dycore, only: dycore_is +! !ARGUMENTS: + implicit none + +! !LOCAL VARIABLES: + integer m + character(len=max_hcoordname_len) outgrid + +!----------------------------------------------------------------------- + + if (dycore_is('SE')) then + outgrid = 'GLL' + else if (dycore_is('EUL')) then + outgrid = 'gauss_grid' + else if (dycore_is('EUL')) then + outgrid = 'unknown' + end if + + if (trim(outgrid) == 'gauss_grid') then + call addfld ('CLAT1&IC', horiz_only, 'I', ' ','cos lat for bfb testing', gridname=trim(outgrid)) + call add_default ('CLAT1&IC',0,'I') + call addfld ('CLON1&IC', horiz_only, 'I', ' ','cos lon for bfb testing', gridname=trim(outgrid)) + call add_default ('CLON1&IC',0,'I') + call addfld ('PHI&IC', horiz_only, 'I', ' ','lat for bfb testing', gridname=trim(outgrid)) + call add_default ('PHI&IC',0, 'I') + call addfld ('LAM&IC', horiz_only, 'I', ' ','lon for bfb testing', gridname=trim(outgrid)) + call add_default ('LAM&IC',0, 'I') + + call addfld ('CLAT', horiz_only, 'A', ' ', 'cos lat for bfb testing', gridname=trim(outgrid)) + call add_default ('CLAT',2,' ') + + call addfld ('fixmas', horiz_only, 'A', 'percent','Mass fixer',gridname=trim(outgrid)) + call add_default ('fixmas',2,' ') + call addfld ('beta', horiz_only, 'A', 'percent','Energy fixer',gridname=trim(outgrid)) + call add_default ('beta',2,' ') + end if + + call addfld ('q', (/ 'lev' /), 'A', 'kg/kg', 'Q for scam',gridname=trim(outgrid)) + call add_default ('q',2, ' ') + call addfld ('u', (/ 'lev' /), 'A', 'm/s', 'U for scam',gridname=trim(outgrid)) + call add_default ('u',2,' ') + call addfld ('v', (/ 'lev' /), 'A', 'm/s', 'V for scam',gridname=trim(outgrid)) + call add_default ('v',2,' ') + call addfld ('t', (/ 'lev' /), 'A', 'K', 'Temperature for scam',gridname=trim(outgrid)) + call add_default ('t',2,' ') + call addfld ('Tg', horiz_only, 'A', 'K', 'Surface temperature (radiative) for scam',gridname='physgrid') + call add_default ('Tg',2,' ') + call addfld ('Ps', horiz_only, 'A', 'Pa', 'Surface Pressure for SCAM',gridname=trim(outgrid)) + call add_default ('Ps',2,' ') + call addfld ('divT3d', (/ 'lev' /), 'A', 'K', 'Dynamics Residual for T',gridname=trim(outgrid)) + call add_default ('divT3d',2,' ') + call addfld ('divU3d', (/ 'lev' /), 'A', 'K', 'Dynamics Residual for U',gridname=trim(outgrid)) + call add_default ('divU3d',2,' ') + call addfld ('divV3d', (/ 'lev' /), 'A', 'K', 'Dynamics Residual for V',gridname=trim(outgrid)) + call add_default ('divV3d',2,' ') + call addfld ('heat_glob',horiz_only, 'A', 'K/s', 'Global mean total energy difference') + call add_default ('heat_glob',2,' ') + do m=1,pcnst + call addfld (trim(cnst_name(m))//'_dten', (/ 'lev' /), 'A', 'kg/kg', & + trim(cnst_name(m))//' IOP Dynamics Residual for '//trim(cnst_name(m)),gridname=trim(outgrid)) + call add_default (trim(cnst_name(m))//'_dten',2,' ') + if (trim(outgrid) == 'gauss_grid') then + call addfld (trim(cnst_name(m))//'_alph', horiz_only, 'A', 'kg/kg',trim(cnst_name(m))//' alpha constituent fixer', & + gridname=trim(outgrid)) + call add_default (trim(cnst_name(m))//'_alph',2,' ') + call addfld (trim(cnst_name(m))//'_dqfx', (/ 'lev' /), 'A', 'kg/kg',trim(cnst_name(m))//' dqfx3 fixer', & + gridname=trim(outgrid)) + call add_default (trim(cnst_name(m))//'_dqfx',2,' ') + end if + end do + call addfld ('shflx', horiz_only, 'A', 'W/m2', 'Surface sensible heat flux for scam',gridname='physgrid') + call add_default ('shflx',2,' ') + call addfld ('lhflx', horiz_only, 'A', 'W/m2', 'Surface latent heat flux for scam',gridname='physgrid') + call add_default ('lhflx',2,' ') + call addfld ('trefht', horiz_only, 'A', 'K', 'Reference height temperature',gridname='physgrid') + call add_default ('trefht',2,' ') + call addfld ('Tsair', horiz_only, 'A', 'K', 'Reference height temperature for scam',gridname='physgrid') + call add_default ('Tsair',2,' ') + call addfld ('phis', horiz_only, 'I', 'm2/s2','Surface geopotential for scam',gridname='physgrid') + call add_default ('phis',2,' ') + call addfld ('Prec', horiz_only, 'A', 'm/s', 'Total (convective and large-scale) precipitation rate for scam', & + gridname='physgrid') + call add_default ('Prec',2,' ') + call addfld ('omega', (/ 'lev' /), 'A', 'Pa/s', 'Vertical velocity (pressure)',gridname='physgrid') + call add_default ('omega',2,' ') + + end subroutine initialize_iop_history !####################################################################### end module history_scam diff --git a/src/control/ncdio_atm.F90 b/src/control/ncdio_atm.F90 index fd57906da4..f727fc8f25 100644 --- a/src/control/ncdio_atm.F90 +++ b/src/control/ncdio_atm.F90 @@ -20,6 +20,9 @@ module ncdio_atm use scamMod, only: scmlat,scmlon,single_column use cam_logfile, only: iulog use string_utils, only: to_lower + use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id, & + cam_grid_dimensions, cam_grid_get_latvals, cam_grid_get_lonvals, & + max_hcoordname_len ! ! !PUBLIC TYPES: implicit none @@ -40,11 +43,8 @@ module ncdio_atm module procedure infld_real_3d_3d end interface - public :: infld - integer STATUS - real(r8) surfdat !----------------------------------------------------------------------- contains @@ -66,10 +66,8 @@ subroutine infld_real_1d_2d(varname, ncid, dimname1, & ! !USES ! - use pio, only: pio_get_var, pio_read_darray, pio_setdebuglevel - use pio, only: PIO_MAX_NAME, pio_inquire, pio_inq_dimname - use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id, & - cam_grid_dimensions + use pio, only: pio_read_darray, pio_setdebuglevel + use pio, only: PIO_MAX_NAME, pio_inq_dimname use cam_pio_utils, only: cam_pio_check_var, cam_pio_inq_var_fill ! @@ -93,7 +91,7 @@ subroutine infld_real_1d_2d(varname, ncid, dimname1, & ! !LOCAL VARIABLES: type(io_desc_t), pointer :: iodesc integer :: grid_id ! grid ID for data mapping - integer :: i, j ! indices + integer :: j ! index integer :: ierr ! error status type(var_desc_t) :: varid ! variable id integer :: no_fill @@ -104,56 +102,49 @@ subroutine infld_real_1d_2d(varname, ncid, dimname1, & integer :: dimlens(PIO_MAX_VAR_DIMS) ! file variable shape integer :: grid_dimlens(2) - ! Offsets for reading global variables - integer :: strt(1) = 1 ! start ncol index for netcdf 1-d - integer :: cnt (1) = 1 ! ncol count for netcdf 1-d character(len=PIO_MAX_NAME) :: tmpname character(len=128) :: errormsg logical :: readvar_tmp ! if true, variable is on tape character(len=*), parameter :: subname='INFLD_REAL_1D_2D' ! subroutine name - - ! For SCAM - real(r8) :: closelat, closelon - integer :: lonidx, latidx - - nullify(iodesc) + character(len=max_hcoordname_len) :: vargridname ! Name of variable's grid ! !----------------------------------------------------------------------- ! ! call pio_setdebuglevel(3) + nullify(iodesc) + ! ! Error conditions ! if (present(gridname)) then - grid_id = cam_grid_id(trim(gridname)) + vargridname=trim(gridname) else - grid_id = cam_grid_id('physgrid') + vargridname='physgrid' + end if + + if (single_column .and. vargridname=='physgrid') then + vargridname='physgrid_scm' end if + + grid_id = cam_grid_id(trim(vargridname)) + if (.not. cam_grid_check(grid_id)) then if(masterproc) then - if (present(gridname)) then - write(errormsg, *)': invalid gridname, "',trim(gridname),'", specified for field ',trim(varname) - else - write(errormsg, *)': Internal error, no "physgrid" gridname' - end if + write(errormsg, *)': invalid gridname, "',trim(vargridname),'", specified for field ',trim(varname) end if call endrun(trim(subname)//errormsg) end if - ! Get the number of columns in the global grid. - call cam_grid_dimensions(grid_id, grid_dimlens) - if (debug .and. masterproc) then - if (present(gridname)) then - write(iulog, '(5a)') trim(subname),': field = ',trim(varname),', grid = ',trim(gridname) - else - write(iulog, '(4a)') trim(subname),': field = ',trim(varname),', grid = physgrid' - end if - call shr_sys_flush(iulog) + write(iulog, '(5a)') trim(subname),': field = ',trim(varname),', grid = ',trim(vargridname) + call shr_sys_flush(iulog) end if + + ! Get the number of columns in the global grid. + call cam_grid_dimensions(grid_id, grid_dimlens) ! ! Read netCDF file ! @@ -190,7 +181,7 @@ subroutine infld_real_1d_2d(varname, ncid, dimname1, & else ! Check that the number of columns in the file matches the number of ! columns in the grid object. - if (dimlens(1) /= grid_dimlens(1)) then + if (dimlens(1) /= grid_dimlens(1) .and. .not. single_column) then readvar = .false. return end if @@ -213,20 +204,14 @@ subroutine infld_real_1d_2d(varname, ncid, dimname1, & ndims = ndims - 1 end if - ! NB: strt and cnt were initialized to 1 - if (single_column) then - !!XXgoldyXX: Clearly, this will not work for an unstructured dycore - call endrun(trim(subname)//': SCAM not supported in this configuration') - else - ! All distributed array processing - call cam_grid_get_decomp(grid_id, arraydimsize, dimlens(1:ndims), & - pio_double, iodesc) - call pio_read_darray(ncid, varid, iodesc, field, ierr) - if (present(fillvalue)) then - ierr = cam_pio_inq_var_fill(ncid, varid, fillvalue) - end if - end if - + ! nb: strt and cnt were initialized to 1 + ! all distributed array processing + call cam_grid_get_decomp(grid_id, arraydimsize, dimlens(1:ndims), & + pio_double, iodesc) + call pio_read_darray(ncid, varid, iodesc, field, ierr) + if (present(fillvalue)) then + ierr = cam_pio_inq_var_fill(ncid, varid, fillvalue) + end if if (masterproc) write(iulog,*) subname//': read field '//trim(varname) @@ -245,7 +230,7 @@ end subroutine infld_real_1d_2d ! ! !INTERFACE: subroutine infld_real_2d_2d(varname, ncid, dimname1, dimname2, & - dim1b, dim1e, dim2b, dim2e, field, readvar, gridname, timelevel, & + dim1b, dim1e, dim2b, dim2e, field, readvar, gridname, timelevel, & fillvalue) ! ! !DESCRIPTION: @@ -256,8 +241,7 @@ subroutine infld_real_2d_2d(varname, ncid, dimname1, dimname2, & ! use pio, only: pio_get_var, pio_read_darray, pio_setdebuglevel - use pio, only: PIO_MAX_NAME, pio_inquire, pio_inq_dimname - use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id + use pio, only: PIO_MAX_NAME, pio_inq_dimname use cam_pio_utils, only: cam_permute_array, calc_permutation use cam_pio_utils, only: cam_pio_check_var, cam_pio_inq_var_fill @@ -307,6 +291,7 @@ subroutine infld_real_2d_2d(varname, ncid, dimname1, dimname2, & logical :: readvar_tmp ! if true, variable is on tape character(len=*), parameter :: subname='INFLD_REAL_2D_2D' ! subroutine name character(len=PIO_MAX_NAME) :: field_dnames(2) + character(len=max_hcoordname_len) :: vargridname ! Name of variable's grid ! For SCAM real(r8) :: closelat, closelon @@ -329,30 +314,27 @@ subroutine infld_real_2d_2d(varname, ncid, dimname1, dimname2, & ! Error conditions ! if (present(gridname)) then - grid_id = cam_grid_id(trim(gridname)) + vargridname=trim(gridname) else - grid_id = cam_grid_id('physgrid') + vargridname='physgrid' + end if + + if (single_column .and. vargridname=='physgrid') then + vargridname='physgrid_scm' end if + + grid_id = cam_grid_id(trim(vargridname)) if (.not. cam_grid_check(grid_id)) then if(masterproc) then - if (present(gridname)) then - write(errormsg, *)': invalid gridname, "',trim(gridname),'", specified for field ',trim(varname) - else - write(errormsg, *)': Internal error, no "physgrid" gridname' - end if + write(errormsg, *)': invalid gridname, "',trim(vargridname),'", specified for field ',trim(varname) end if call endrun(trim(subname)//errormsg) end if - if (debug .and. masterproc) then - if (present(gridname)) then - write(iulog, '(5a)') trim(subname),': field = ',trim(varname),', grid = ',trim(gridname) - else - write(iulog, '(4a)') trim(subname),': field = ',trim(varname),', grid = physgrid' + if (debug .and. masterproc) then + write(iulog, '(5a)') trim(subname),': field = ',trim(varname),', grid = ',trim(vargridname) + call shr_sys_flush(iulog) end if - call shr_sys_flush(iulog) - end if - ! ! Read netCDF file ! @@ -485,10 +467,7 @@ subroutine infld_real_2d_3d(varname, ncid, dimname1, dimname2, & ! use pio, only: pio_get_var, pio_read_darray, pio_setdebuglevel - use pio, only: PIO_MAX_NAME, pio_inquire, pio_inq_dimname - use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id, & - cam_grid_dimensions - use cam_pio_utils, only: cam_permute_array, calc_permutation + use pio, only: PIO_MAX_NAME, pio_inq_dimname use cam_pio_utils, only: cam_pio_check_var, cam_pio_inq_var_fill ! @@ -515,14 +494,11 @@ subroutine infld_real_2d_3d(varname, ncid, dimname1, dimname2, & ! !LOCAL VARIABLES: type(io_desc_t), pointer :: iodesc integer :: grid_id ! grid ID for data mapping - integer :: i, j, k ! indices + integer :: j ! index integer :: ierr ! error status type(var_desc_t) :: varid ! variable id integer :: arraydimsize(3) ! field dimension lengths - integer :: arraydimids(2) ! Dimension IDs - integer :: permutation(2) - logical :: ispermuted integer :: ndims ! number of dimensions integer :: dimids(PIO_MAX_VAR_DIMS) ! file variable dims @@ -534,56 +510,49 @@ subroutine infld_real_2d_3d(varname, ncid, dimname1, dimname2, & integer :: cnt (3) = 1 ! ncol, lev counts for netcdf 2-d character(len=PIO_MAX_NAME) :: tmpname - real(r8), pointer :: tmp3d(:,:,:) ! input data for permutation - logical :: readvar_tmp ! if true, variable is on tape character(len=*), parameter :: subname='INFLD_REAL_2D_3D' ! subroutine name character(len=128) :: errormsg character(len=PIO_MAX_NAME) :: field_dnames(2) character(len=PIO_MAX_NAME) :: file_dnames(3) - - ! For SCAM - real(r8) :: closelat, closelon - integer :: lonidx, latidx - - nullify(iodesc) + character(len=max_hcoordname_len) :: vargridname ! Name of variable's grid ! !----------------------------------------------------------------------- ! ! call pio_setdebuglevel(3) + nullify(iodesc) + ! ! Error conditions ! if (present(gridname)) then - grid_id = cam_grid_id(trim(gridname)) + vargridname=trim(gridname) else - grid_id = cam_grid_id('physgrid') + vargridname='physgrid' end if + + ! if running single column mode then we need to use scm grid to read proper column + if (single_column .and. vargridname=='physgrid') then + vargridname='physgrid_scm' + end if + + grid_id = cam_grid_id(trim(vargridname)) if (.not. cam_grid_check(grid_id)) then if(masterproc) then - if (present(gridname)) then - write(errormsg, *)': invalid gridname, "',trim(gridname),'", specified for field ',trim(varname) - else - write(errormsg, *)': Internal error, no "physgrid" gridname' - end if + write(errormsg, *)': invalid gridname, "',trim(vargridname),'", specified for field ',trim(varname) end if call endrun(trim(subname)//errormsg) end if - ! Get the number of columns in the global grid. - call cam_grid_dimensions(grid_id, grid_dimlens) - if (debug .and. masterproc) then - if (present(gridname)) then - write(iulog, '(5a)') trim(subname),': field = ',trim(varname),', grid = ',trim(gridname) - else - write(iulog, '(4a)') trim(subname),': field = ',trim(varname),', grid = physgrid' - end if + write(iulog, '(5a)') trim(subname),': field = ',trim(varname),', grid = ',trim(vargridname) call shr_sys_flush(iulog) end if + ! Get the number of columns in the global grid. + call cam_grid_dimensions(grid_id, grid_dimlens) ! ! Read netCDF file ! @@ -623,7 +592,7 @@ subroutine infld_real_2d_3d(varname, ncid, dimname1, dimname2, & else ! Check that the number of columns in the file matches the number of ! columns in the grid object. - if (dimlens(1) /= grid_dimlens(1) .and. dimlens(2) /= grid_dimlens(1)) then + if (dimlens(1) /= grid_dimlens(1) .and. dimlens(2) /= grid_dimlens(1) .and. .not. single_column) then readvar = .false. return end if @@ -649,20 +618,13 @@ subroutine infld_real_2d_3d(varname, ncid, dimname1, dimname2, & field_dnames(1) = dimname1 field_dnames(2) = dimname2 ! NB: strt and cnt were initialized to 1 - if (single_column) then - !!XXgoldyXX: Clearly, this will not work for an unstructured dycore - ! Check for permuted dimensions ('out of order' array) -! call calc_permutation(dimids(1:2), arraydimids, permutation, ispermuted) - call endrun(trim(subname)//': SCAM not supported in this configuration') - else - ! All distributed array processing - call cam_grid_get_decomp(grid_id, arraydimsize, dimlens(1:2), & - pio_double, iodesc, field_dnames=field_dnames, & - file_dnames=file_dnames(1:2)) - call pio_read_darray(ncid, varid, iodesc, field, ierr) - if (present(fillvalue)) then - ierr = cam_pio_inq_var_fill(ncid, varid, fillvalue) - end if + ! All distributed array processing + call cam_grid_get_decomp(grid_id, arraydimsize, dimlens(1:2), & + pio_double, iodesc, field_dnames=field_dnames, & + file_dnames=file_dnames(1:2)) + call pio_read_darray(ncid, varid, iodesc, field, ierr) + if (present(fillvalue)) then + ierr = cam_pio_inq_var_fill(ncid, varid, fillvalue) end if if (masterproc) write(iulog,*) subname//': read field '//trim(varname) @@ -693,8 +655,7 @@ subroutine infld_real_3d_3d(varname, ncid, dimname1, dimname2, dimname3, & ! use pio, only: pio_get_var, pio_read_darray, pio_setdebuglevel - use pio, only: PIO_MAX_NAME, pio_inquire, pio_inq_dimname - use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id + use pio, only: PIO_MAX_NAME, pio_inq_dimname use cam_pio_utils, only: cam_permute_array, calc_permutation use cam_pio_utils, only: cam_pio_check_var, cam_pio_inq_var_fill @@ -749,6 +710,7 @@ subroutine infld_real_3d_3d(varname, ncid, dimname1, dimname2, dimname3, & character(len=128) :: errormsg character(len=PIO_MAX_NAME) :: field_dnames(3) character(len=PIO_MAX_NAME) :: file_dnames(4) + character(len=max_hcoordname_len) :: vargridname ! Name of variable's grid ! For SCAM real(r8) :: closelat, closelon @@ -771,35 +733,32 @@ subroutine infld_real_3d_3d(varname, ncid, dimname1, dimname2, dimname3, & dim1b, dim1e, dim2b, dim2e, dim3b, dim3e, & field, readvar, gridname, timelevel) else - ! ! Error conditions ! if (present(gridname)) then - grid_id = cam_grid_id(trim(gridname)) + vargridname=trim(gridname) else - grid_id = cam_grid_id('physgrid') + vargridname='physgrid' end if + + ! if running single column mode then we need to use scm grid to read proper column + if (single_column .and. vargridname=='physgrid') then + vargridname='physgrid_scm' + end if + + grid_id = cam_grid_id(trim(vargridname)) if (.not. cam_grid_check(grid_id)) then if(masterproc) then - if (present(gridname)) then - write(errormsg, *)': invalid gridname, "',trim(gridname),'", specified for field ',trim(varname) - else - write(errormsg, *)': Internal error, no "physgrid" gridname' - end if + write(errormsg, *)': invalid gridname, "',trim(vargridname),'", specified for field ',trim(varname) end if call endrun(trim(subname)//errormsg) end if if (debug .and. masterproc) then - if (present(gridname)) then - write(iulog, '(5a)') trim(subname),': field = ',trim(varname),', grid = ',trim(gridname) - else - write(iulog, '(4a)') trim(subname),': field = ',trim(varname),', grid = physgrid' - end if + write(iulog, '(5a)') trim(subname),': field = ',trim(varname),', grid = ',trim(vargridname) call shr_sys_flush(iulog) end if - ! ! Read netCDF file ! diff --git a/src/control/runtime_opts.F90 b/src/control/runtime_opts.F90 index 6d5a6e1058..915664cdb9 100644 --- a/src/control/runtime_opts.F90 +++ b/src/control/runtime_opts.F90 @@ -41,8 +41,6 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) use phys_control, only: phys_ctl_readnl use wv_saturation, only: wv_sat_readnl use ref_pres, only: ref_pres_readnl - use cam3_aero_data, only: cam3_aero_data_readnl - use cam3_ozone_data, only: cam3_ozone_data_readnl use dadadj_cam, only: dadadj_readnl use macrop_driver, only: macrop_driver_readnl use microp_driver, only: microp_driver_readnl @@ -143,8 +141,6 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) call phys_ctl_readnl(nlfilename) call wv_sat_readnl(nlfilename) call ref_pres_readnl(nlfilename) - call cam3_aero_data_readnl(nlfilename) - call cam3_ozone_data_readnl(nlfilename) call dadadj_readnl(nlfilename) call macrop_driver_readnl(nlfilename) call microp_driver_readnl(nlfilename) diff --git a/src/control/scamMod.F90 b/src/control/scamMod.F90 index b18169b340..e26a2e63b9 100644 --- a/src/control/scamMod.F90 +++ b/src/control/scamMod.F90 @@ -14,31 +14,47 @@ module scamMod ! this module provide flexibility to affect the forecast by overriding ! parameterization prognosed tendencies with observed tendencies ! of a particular field program recorded on the IOP file. - ! + ! ! Public functions/subroutines: ! scam_readnl !----------------------------------------------------------------------- -use shr_kind_mod, only: r8 => shr_kind_r8 +use shr_kind_mod, only: r8 => shr_kind_r8, cl => shr_kind_cl +use spmd_utils, only: masterproc,npes use pmgrid, only: plon, plat, plev, plevp -use constituents, only: pcnst +use constituents, only: cnst_get_ind, pcnst, cnst_name +use netcdf, only: NF90_NOERR,NF90_CLOSE,NF90_GET_VAR,NF90_INQUIRE_DIMENSION, & + NF90_INQ_DIMID, NF90_INQ_VARID, NF90_NOWRITE, NF90_OPEN, & + NF90_GET_ATT,NF90_GLOBAL,NF90_INQUIRE_ATTRIBUTE, & + NF90_INQUIRE_VARIABLE, NF90_MAX_VAR_DIMS, nf90_get_var use shr_scam_mod, only: shr_scam_getCloseLatLon -use dycore, only: dycore_is use cam_logfile, only: iulog use cam_abortutils, only: endrun +use time_manager, only: get_curr_date, get_nstep,is_first_step,get_start_date,timemgr_time_inc +use error_messages, only: handle_ncerr + implicit none private ! PUBLIC INTERFACES: -public scam_readnl ! read SCAM namelist options +public :: scam_readnl ! read SCAM namelist options +public :: readiopdata ! read iop boundary data +public :: setiopupdate ! find index in iopboundary data for current time +public :: plevs0 ! Define the pressures of the interfaces and midpoints +public :: scmiop_flbc_inti +public :: setiopupdate_init ! PUBLIC MODULE DATA: real(r8), public :: pressure_levels(plev) real(r8), public :: scmlat ! input namelist latitude for scam real(r8), public :: scmlon ! input namelist longitude for scam +real(r8), public :: closeioplat ! closest iop latitude for scam +real(r8), public :: closeioplon ! closest iop longitude for scam +integer, public :: closeioplatidx ! file array index of closest iop latitude for scam +integer, public :: closeioplonidx ! file array index closest iop longitude for scam integer, parameter :: num_switches = 20 @@ -47,34 +63,35 @@ module scamMod logical, public :: single_column ! Using IOP file or not logical, public :: use_iop ! Using IOP file or not logical, public :: use_pert_init ! perturb initial values -logical, public :: use_pert_frc ! perturb forcing +logical, public :: use_pert_frc ! perturb forcing logical, public :: switch(num_switches) ! Logical flag settings from GUI logical, public :: l_uvphys ! If true, update u/v after TPHYS logical, public :: l_uvadvect ! If true, T, U & V will be passed to SLT -logical, public :: l_conv ! use flux divergence terms for T and q? +logical, public :: l_conv ! use flux divergence terms for T and q? logical, public :: l_divtr ! use flux divergence terms for constituents? logical, public :: l_diag ! do we want available diagnostics? integer, public :: error_code ! Error code from netCDF reads integer, public :: initTimeIdx integer, public :: seedval +integer :: bdate, last_date, last_sec -character*(max_path_len), public :: modelfile -character*(max_path_len), public :: analysisfile -character*(max_path_len), public :: sicfile -character*(max_path_len), public :: userfile -character*(max_path_len), public :: sstfile -character*(max_path_len), public :: lsmpftfile -character*(max_path_len), public :: pressfile -character*(max_path_len), public :: topofile -character*(max_path_len), public :: ozonefile -character*(max_path_len), public :: iopfile -character*(max_path_len), public :: absemsfile -character*(max_path_len), public :: aermassfile -character*(max_path_len), public :: aeropticsfile -character*(max_path_len), public :: timeinvfile -character*(max_path_len), public :: lsmsurffile -character*(max_path_len), public :: lsminifile +character(len=max_path_len), public :: modelfile +character(len=max_path_len), public :: analysisfile +character(len=max_path_len), public :: sicfile +character(len=max_path_len), public :: userfile +character(len=max_path_len), public :: sstfile +character(len=max_path_len), public :: lsmpftfile +character(len=max_path_len), public :: pressfile +character(len=max_path_len), public :: topofile +character(len=max_path_len), public :: ozonefile +character(len=max_path_len), public :: iopfile +character(len=max_path_len), public :: absemsfile +character(len=max_path_len), public :: aermassfile +character(len=max_path_len), public :: aeropticsfile +character(len=max_path_len), public :: timeinvfile +character(len=max_path_len), public :: lsmsurffile +character(len=max_path_len), public :: lsminifile ! note that scm_zadv_q is set to slt to be consistent with CAM BFB testing @@ -102,16 +119,18 @@ module scamMod real(r8), public :: qinitobs(plev,pcnst)! initial tracer field real(r8), public :: cldliqobs(plev) ! actual W.V. Mixing ratio real(r8), public :: cldiceobs(plev) ! actual W.V. Mixing ratio -real(r8), public :: numliqobs(plev) ! actual -real(r8), public :: numiceobs(plev) ! actual -real(r8), public :: precobs(1) ! observed precipitation -real(r8), public :: lhflxobs(1) ! observed surface latent heat flux +real(r8), public :: numliqobs(plev) ! actual +real(r8), public :: numiceobs(plev) ! actual +real(r8), public :: precobs(1) ! observed precipitation +real(r8), public :: lhflxobs(1) ! observed surface latent heat flux +real(r8), public :: heat_glob_scm(1) ! observed heat total real(r8), public :: shflxobs(1) ! observed surface sensible heat flux real(r8), public :: q1obs(plev) ! observed apparent heat source real(r8), public :: q2obs(plev) ! observed apparent heat sink -real(r8), public :: tdiff(plev) ! model minus observed temp +real(r8), public :: tdiff(plev) ! model minus observed temp real(r8), public :: tground(1) ! ground temperature -real(r8), public :: tobs(plev) ! actual temperature +real(r8), public :: psobs ! observed surface pressure +real(r8), public :: tobs(plev) ! observed temperature real(r8), public :: tsair(1) ! air temperature at the surface real(r8), public :: udiff(plev) ! model minus observed uwind real(r8), public :: uobs(plev) ! actual u wind @@ -124,6 +143,13 @@ module scamMod real(r8), public :: asdirobs(1) ! observed asdir real(r8), public :: asdifobs(1) ! observed asdif +real(r8), public :: co2vmrobs(1) ! observed co2vmr +real(r8), public :: ch4vmrobs(1) ! observed ch3vmr +real(r8), public :: n2ovmrobs(1) ! observed n2ovmr +real(r8), public :: f11vmrobs(1) ! observed f11vmr +real(r8), public :: f12vmrobs(1) ! observed f12vmr +real(r8), public :: soltsiobs(1) ! observed solar + real(r8), public :: wfld(plev) ! Vertical motion (slt) real(r8), public :: wfldh(plevp) ! Vertical motion (slt) real(r8), public :: divq(plev,pcnst) ! Divergence of moisture @@ -142,22 +168,23 @@ module scamMod ! SCAM public data defaults logical, public :: doiopupdate = .false. ! do we need to read next iop timepoint -logical, public :: have_lhflx = .false. ! dataset contains lhflx +logical, public :: have_lhflx = .false. ! dataset contains lhflx logical, public :: have_shflx = .false. ! dataset contains shflx +logical, public :: have_heat_glob = .false. ! dataset contains heat total logical, public :: have_tg = .false. ! dataset contains tg logical, public :: have_tsair = .false. ! dataset contains tsair -logical, public :: have_divq = .false. ! dataset contains divq +logical, public :: have_divq = .false. ! dataset contains divq logical, public :: have_divt = .false. ! dataset contains divt -logical, public :: have_divq3d = .false. ! dataset contains divq3d +logical, public :: have_divq3d = .false. ! dataset contains divq3d logical, public :: have_vertdivu = .false. ! dataset contains vertdivu logical, public :: have_vertdivv = .false. ! dataset contains vertdivv logical, public :: have_vertdivt = .false. ! dataset contains vertdivt -logical, public :: have_vertdivq = .false. ! dataset contains vertdivq +logical, public :: have_vertdivq = .false. ! dataset contains vertdivq logical, public :: have_divt3d = .false. ! dataset contains divt3d logical, public :: have_divu3d = .false. ! dataset contains divu3d logical, public :: have_divv3d = .false. ! dataset contains divv3d logical, public :: have_divu = .false. ! dataset contains divu -logical, public :: have_divv = .false. ! dataset contains divv +logical, public :: have_divv = .false. ! dataset contains divv logical, public :: have_omega = .false. ! dataset contains omega logical, public :: have_phis = .false. ! dataset contains phis logical, public :: have_ptend = .false. ! dataset contains ptend @@ -165,10 +192,10 @@ module scamMod logical, public :: have_q = .false. ! dataset contains q logical, public :: have_q1 = .false. ! dataset contains Q1 logical, public :: have_q2 = .false. ! dataset contains Q2 -logical, public :: have_prec = .false. ! dataset contains prec +logical, public :: have_prec = .false. ! dataset contains prec logical, public :: have_t = .false. ! dataset contains t -logical, public :: have_u = .false. ! dataset contains u -logical, public :: have_v = .false. ! dataset contains v +logical, public :: have_u = .false. ! dataset contains u +logical, public :: have_v = .false. ! dataset contains v logical, public :: have_cld = .false. ! dataset contains cld logical, public :: have_cldliq = .false. ! dataset contains cldliq logical, public :: have_cldice = .false. ! dataset contains cldice @@ -179,41 +206,47 @@ module scamMod logical, public :: have_aldif = .false. ! dataset contains aldif logical, public :: have_asdir = .false. ! dataset contains asdir logical, public :: have_asdif = .false. ! dataset contains asdif -logical, public :: use_camiop = .false. ! use cam generated forcing +logical, public :: use_camiop = .false. ! use cam generated forcing logical, public :: use_3dfrc = .false. ! use 3d forcing logical, public :: isrestart = .false. ! If this is a restart step or not - + ! SCAM namelist defaults logical, public :: scm_backfill_iop_w_init = .false. ! Backfill missing IOP data from initial file logical, public :: scm_relaxation = .false. ! Use relaxation logical, public :: scm_crm_mode = .false. ! Use column radiation mode logical, public :: scm_cambfb_mode = .false. ! Use extra CAM IOP fields to assure bit for bit match with CAM run -logical, public :: scm_use_obs_T = .false. ! Use the SCAM-IOP specified observed T at each time step instead of forecasting. -logical, public :: scm_force_latlon = .false. ! force scam to use the lat lon fields specified in the scam namelist not what is closest to iop avail lat lon -real*8, public :: scm_relax_top_p = 1.e36_r8 ! upper bound for scm relaxation -real*8, public :: scm_relax_bot_p = -1.e36_r8 ! lower bound for scm relaxation -real*8, public :: scm_relax_tau_sec = 10800._r8 ! relaxation time constant (sec) +logical, public :: scm_use_obs_T = .false. ! Use the SCAM-IOP observed T at each timestep instead of forecasting. +logical, public :: scm_force_latlon = .false. ! force scam to use the lat lon fields specified in the namelist not closest +real(r8), public :: scm_relaxation_low ! lowest level to apply relaxation +real(r8), public :: scm_relaxation_high ! highest level to apply relaxation +real(r8), public :: scm_relax_top_p = 0._r8 ! upper bound for scm relaxation +real(r8), public :: scm_relax_bot_p = huge(1._r8) ! lower bound for scm relaxation +real(r8), public :: scm_relax_tau_sec = 10800._r8 ! relaxation time constant (sec) ! +++BPM: ! modification... allow a linear ramp in relaxation time scale: logical, public :: scm_relax_linear = .false. -real*8, public :: scm_relax_tau_bot_sec = 10800._r8 -real*8, public :: scm_relax_tau_top_sec = 10800._r8 +real(r8), public :: scm_relax_tau_bot_sec = 10800._r8 +real(r8), public :: scm_relax_tau_top_sec = 10800._r8 character(len=26), public :: scm_relax_fincl(pcnst) ! ! note that scm_use_obs_uv is set to true to be consistent with CAM BFB testing ! -logical, public :: scm_use_obs_uv = .true. ! Use the SCAM-IOP specified observed u,v at each time step instead of forecasting. +logical, public :: scm_use_obs_uv = .true. ! Use the SCAM-IOP observed u,v at each time step instead of forecasting. -logical, public :: scm_use_obs_qv = .false. ! Use the SCAM-IOP specified observed qv at each time step instead of forecasting. +logical, public :: scm_use_obs_qv = .false. ! Use the SCAM-IOP observed qv at each time step instead of forecasting. +logical, public :: scm_use_3dfrc = .false. ! Use CAMIOP 3d forcing if true, else use dycore vertical plus horizontal logical, public :: scm_iop_lhflxshflxTg = .false. !turn off LW rad logical, public :: scm_iop_Tg = .false. !turn off LW rad character(len=200), public :: scm_clubb_iop_name ! IOP name for CLUBB +integer, allocatable, public :: tsec(:) +integer, public :: ntime + !======================================================================= contains !======================================================================= @@ -224,8 +257,6 @@ subroutine scam_readnl(nlfile,single_column_in,scmlat_in,scmlon_in) use units, only: getunit, freeunit use dycore, only: dycore_is use wrap_nf, only: wrap_open - use spmd_utils, only : masterproc,npes - use netcdf, only : nf90_inquire_attribute,NF90_NOERR,NF90_GLOBAL,NF90_NOWRITE !---------------------------Arguments----------------------------------- @@ -240,40 +271,38 @@ subroutine scam_readnl(nlfile,single_column_in,scmlat_in,scmlon_in) integer :: unitn, ierr, i integer :: ncid integer :: iatt - integer :: latidx, lonidx logical :: adv - real(r8) :: ioplat,ioplon ! this list should include any variable that you might want to include in the namelist namelist /scam_nl/ iopfile, scm_iop_lhflxshflxTg, scm_iop_Tg, scm_relaxation, & scm_relax_top_p,scm_relax_bot_p,scm_relax_tau_sec, & scm_cambfb_mode,scm_crm_mode,scm_zadv_uv,scm_zadv_T,scm_zadv_q,& - scm_use_obs_T, scm_use_obs_uv, scm_use_obs_qv, & + scm_use_obs_T, scm_use_obs_uv, scm_use_obs_qv, scm_use_3dfrc, & scm_relax_linear, scm_relax_tau_top_sec, & - scm_relax_tau_bot_sec, scm_force_latlon, scm_relax_fincl, scm_backfill_iop_w_init + scm_relax_tau_bot_sec, scm_force_latlon, scm_relax_fincl, & + scm_backfill_iop_w_init single_column=single_column_in iopfile = ' ' scm_clubb_iop_name = ' ' scm_relax_fincl(:) = ' ' - if( single_column ) then - if( npes.gt.1) call endrun('SCAM_READNL: SCAM doesnt support using more than 1 pe.') + if( npes>1) call endrun('SCAM_READNL: SCAM doesnt support using more than 1 pe.') - if (.not. dycore_is('EUL') .or. plon /= 1 .or. plat /=1 ) then + if ( .not. (dycore_is('EUL') .or. dycore_is('SE')) .or. plon /= 1 .or. plat /=1 ) then call endrun('SCAM_SETOPTS: must compile model for SCAM mode when namelist parameter single_column is .true.') endif scmlat=scmlat_in scmlon=scmlon_in - - if( scmlat .lt. -90._r8 .or. scmlat .gt. 90._r8 ) then + + if( scmlat < -90._r8 .or. scmlat > 90._r8 ) then call endrun('SCAM_READNL: SCMLAT must be between -90. and 90. degrees.') - elseif( scmlon .lt. 0._r8 .or. scmlon .gt. 360._r8 ) then + elseif( scmlon < 0._r8 .or. scmlon > 360._r8 ) then call endrun('SCAM_READNL: SCMLON must be between 0. and 360. degrees.') end if - + ! Read namelist if (masterproc) then unitn = getunit() @@ -288,11 +317,11 @@ subroutine scam_readnl(nlfile,single_column_in,scmlat_in,scmlon_in) close(unitn) call freeunit(unitn) end if - + ! Error checking: - + iopfile = trim(iopfile) - if( iopfile .ne. "" ) then + if( iopfile /= "" ) then use_iop = .true. else call endrun('SCAM_READNL: must specify IOP file for single column mode') @@ -300,23 +329,22 @@ subroutine scam_readnl(nlfile,single_column_in,scmlat_in,scmlon_in) call wrap_open( iopfile, NF90_NOWRITE, ncid ) - if( nf90_inquire_attribute( ncid, NF90_GLOBAL, 'CAM_GENERATED_FORCING', iatt ) .EQ. NF90_NOERR ) then + if( nf90_inquire_attribute( ncid, NF90_GLOBAL, 'CAM_GENERATED_FORCING', iatt ) == NF90_NOERR ) then use_camiop = .true. else use_camiop = .false. endif - + ! If we are not forcing the lat and lon from the namelist use the closest lat and lon that is found in the IOP file. if (.not.scm_force_latlon) then - call shr_scam_GetCloseLatLon( ncid, scmlat, scmlon, ioplat, ioplon, latidx, lonidx ) + call shr_scam_GetCloseLatLon( ncid, scmlat, scmlon, closeioplat, closeioplon, closeioplatidx, closeioplonidx ) write(iulog,*) 'SCAM_READNL: using closest IOP column to lat/lon specified in drv_in' write(iulog,*) ' requested lat,lon =',scmlat,', ',scmlon - write(iulog,*) ' closest IOP lat,lon =',ioplat,', ',ioplon - - scmlat = ioplat - scmlon = ioplon + write(iulog,*) ' closest IOP lat,lon =',closeioplat,', ',closeioplon + scmlat = closeioplat + scmlon = closeioplon end if - + if (masterproc) then write (iulog,*) 'Single Column Model Options: ' write (iulog,*) '=============================' @@ -335,6 +363,7 @@ subroutine scam_readnl(nlfile,single_column_in,scmlat_in,scmlon_in) write (iulog,*) ' scm_relax_tau_top_sec = ',scm_relax_tau_top_sec write (iulog,*) ' scm_relax_top_p = ',scm_relax_top_p write (iulog,*) ' scm_use_obs_T = ',scm_use_obs_T + write (iulog,*) ' scm_use_3dfrc = ',scm_use_3dfrc write (iulog,*) ' scm_use_obs_qv = ',scm_use_obs_qv write (iulog,*) ' scm_use_obs_uv = ',scm_use_obs_uv write (iulog,*) ' scm_zadv_T = ',trim(scm_zadv_T) @@ -343,7 +372,7 @@ subroutine scam_readnl(nlfile,single_column_in,scmlat_in,scmlon_in) write (iulog,*) ' scm_relax_finc: ' ! output scm_relax_fincl character array do i=1,pcnst - if (scm_relax_fincl(i) .ne. '') then + if (scm_relax_fincl(i) /= '') then adv = mod(i,4)==0 if (adv) then write (iulog, "(A18)") "'"//trim(scm_relax_fincl(i))//"'," @@ -357,9 +386,1204 @@ subroutine scam_readnl(nlfile,single_column_in,scmlat_in,scmlon_in) print * end if end if - + end subroutine scam_readnl +subroutine readiopdata(hyam, hybm, hyai, hybi, ps0) +!----------------------------------------------------------------------- +! +! Open and read netCDF file containing initial IOP conditions +! +!---------------------------Code history-------------------------------- +! +! Written by J. Truesdale August, 1996, revised January, 1998 +! +!----------------------------------------------------------------------- + use getinterpnetcdfdata, only: getinterpncdata + use string_utils, only: to_lower + use wrap_nf, only: wrap_inq_dimid,wrap_get_vara_realx +!----------------------------------------------------------------------- + implicit none + + character(len=*), parameter :: sub = "read_iop_data" +! +!------------------------------Input Arguments-------------------------- +! + real(r8),intent(in) :: hyam(plev),hybm(plev),hyai(plevp),hybi(plevp),ps0 +! +!------------------------------Locals----------------------------------- +! + integer :: NCID, status + integer :: time_dimID, lev_dimID, lev_varID, varid + integer :: i,j + integer :: nlev + integer :: total_levs + integer :: u_attlen + + integer :: k, m + integer :: icldliq,icldice + integer :: inumliq,inumice + + logical :: have_srf ! value at surface is available + logical :: fill_ends ! + logical :: have_cnst(pcnst) + real(r8) :: dummy + real(r8) :: srf(1) ! value at surface + real(r8) :: hyamiop(plev) ! a hybrid coef midpoint + real(r8) :: hybmiop(plev) ! b hybrid coef midpoint + real(r8) :: pmid(plev) ! pressure at model levels (time n) + real(r8) :: pint(plevp) ! pressure at model interfaces (n ) + real(r8) :: pdel(plev) ! pdel(k) = pint (k+1)-pint (k) + real(r8) :: weight + real(r8) :: tmpdata(1) + real(r8) :: coldata(plev) + real(r8), allocatable :: dplevs( : ) + integer :: strt4(4),cnt4(4) + integer :: nstep + integer :: ios + character(len=128) :: units ! Units + + nstep = get_nstep() + fill_ends= .false. + +! +! Open IOP dataset +! + call handle_ncerr( nf90_open (iopfile, 0, ncid),& + 'ERROR - scamMod.F90:readiopdata', __LINE__) + +! +! if the dataset is a CAM generated dataset set use_camiop to true +! CAM IOP datasets have a global attribute called CAM_GENERATED_IOP +! + if ( nf90_inquire_attribute( ncid, NF90_GLOBAL, 'CAM_GENERATED_FORCING', attnum=i )== NF90_NOERR ) then + use_camiop = .true. + else + use_camiop = .false. + endif + +!===================================================================== +! +! Read time variables + + + status = nf90_inq_dimid (ncid, 'time', time_dimID ) + if (status /= NF90_NOERR) then + status = nf90_inq_dimid (ncid, 'tsec', time_dimID ) + if (status /= NF90_NOERR) then + if (masterproc) write(iulog,*) sub//':ERROR - Could not find dimension ID for time/tsec' + status = NF90_CLOSE ( ncid ) + call endrun(sub // ':ERROR - time/tsec must be present on the IOP file.') + end if + end if + + call handle_ncerr( nf90_inquire_dimension( ncid, time_dimID, len=ntime ),& + 'Error - scamMod.F90:readiopdata unable to find time dimension', __LINE__) + +! +!====================================================== +! read level data +! + status = NF90_INQ_DIMID( ncid, 'lev', lev_dimID ) + if ( status /= nf90_noerr ) then + if (masterproc) write(iulog,*) sub//':ERROR - Could not find variable dim ID for lev' + status = NF90_CLOSE ( ncid ) + call endrun(sub // ':ERROR - Could not find variable dim ID for lev') + end if + + call handle_ncerr( nf90_inquire_dimension( ncid, lev_dimID, len=nlev ),& + 'Error - scamMod.f90:readiopdata unable to find level dimension', __LINE__) + + allocate(dplevs(nlev+1),stat=ios) + if( ios /= 0 ) then + write(iulog,*) sub//':ERROR: failed to allocate dplevs; error = ',ios + call endrun(sub//':ERROR:readiopdata failed to allocate dplevs') + end if + + status = NF90_INQ_VARID( ncid, 'lev', lev_varID ) + if ( status /= nf90_noerr ) then + if (masterproc) write(iulog,*) sub//':ERROR - scamMod.F90:readiopdata:Could not find variable ID for lev' + status = NF90_CLOSE ( ncid ) + call endrun(sub//':ERROR:ould not find variable ID for lev') + end if + + call handle_ncerr( nf90_get_var (ncid, lev_varID, dplevs(:nlev)),& + 'Error - scamMod.F90:readiopdata unable to read pressure levels', __LINE__) +! +!CAM generated forcing already has pressure on millibars convert standard IOP if needed. +! + call handle_ncerr(nf90_inquire_attribute(ncid, lev_varID, 'units', len=u_attlen),& + 'Error - scamMod.F90:readiopdata unable to find units attribute', __LINE__) + call handle_ncerr(nf90_get_att(ncid, lev_varID, 'units', units),& + 'Error - scamMod.F90:readiopdata unable to read units attribute', __LINE__) + units=trim(to_lower(units(1:u_attlen))) + + if ( units=='pa' .or. units=='pascal' .or. units=='pascals' ) then +! +! convert pressure from Pascals to Millibars ( lev is expressed in pascals in iop datasets ) +! + do i=1,nlev + dplevs( i ) = dplevs( i )/100._r8 + end do + endif + + status = nf90_inq_varid( ncid, 'Ps', varid ) + if ( status /= nf90_noerr ) then + have_ps= .false. + if (masterproc) write(iulog,*) sub//':Could not find variable Ps' + if ( .not. scm_backfill_iop_w_init ) then + status = NF90_CLOSE( ncid ) + call endrun(sub//':ERROR :IOP file must contain Surface Pressure (Ps) variable') + else + if ( is_first_step() .and. masterproc) write(iulog,*) 'Using surface pressure value from IC file if present' + endif + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, psobs, strt4) + have_ps = .true. + endif + + +! If the IOP dataset has hyam,hybm,etc it is assumed to be a hybrid level +! dataset + + status = nf90_inq_varid( ncid, 'hyam', varid ) + if ( status == nf90_noerr .and. have_ps) then + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, hyamiop, strt4) + status = nf90_inq_varid( ncid, 'hybm', varid ) + status = nf90_get_var(ncid, varid, hybmiop, strt4) + do i = 1, nlev + dplevs( i ) = 1000.0_r8 * hyamiop( i ) + psobs * hybmiop( i ) / 100.0_r8 + end do + endif + +! add the surface pressure to the pressure level data, so that +! surface boundary condition will be set properly, +! making sure that it is the highest pressure in the array. +! + + total_levs = nlev+1 + dplevs(nlev+1) = psobs/100.0_r8 ! ps is expressed in pascals + do i= nlev, 1, -1 + if ( dplevs(i) > psobs/100.0_r8) then + total_levs = i + dplevs(i) = psobs/100.0_r8 + end if + end do + if (.not. use_camiop ) then + nlev = total_levs + endif + if ( nlev == 1 ) then + if (masterproc) write(iulog,*) sub//':Error - scamMod.F90:readiopdata: Ps too low!' + call endrun(sub//':ERROR:Ps value on datasets is incongurent with levs data - mismatch in units?') + endif + +!===================================================================== +!get global vmrs from camiop file + status = nf90_inq_varid( ncid, 'co2vmr', varid ) + if ( status == nf90_noerr) then + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,co2vmrobs) + else + if (is_first_step()) write(iulog,*)'using column value of co2vmr from boundary data as global volume mixing ratio' + end if + status = nf90_inq_varid( ncid, 'ch4vmr', varid ) + if ( status == nf90_noerr) then + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,ch4vmrobs) + else + if (is_first_step()) write(iulog,*)'using column value of ch4vmr from boundary data as global volume mixing ratio' + end if + status = nf90_inq_varid( ncid, 'n2ovmr', varid ) + if ( status == nf90_noerr) then + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,n2ovmrobs) + else + if (is_first_step()) write(iulog,*)'using column value of n2ovmr from boundary data as global volume mixing ratio' + end if + status = nf90_inq_varid( ncid, 'f11vmr', varid ) + if ( status == nf90_noerr) then + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,f11vmrobs) + else + if (is_first_step()) write(iulog,*)'using column value of f11vmr from boundary data as global volume mixing ratio' + end if + status = nf90_inq_varid( ncid, 'f12vmr', varid ) + if ( status == nf90_noerr) then + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,f12vmrobs) + else + if (is_first_step()) write(iulog,*)'using column value of f12vmr from boundary data as global volume mixing ratio' + end if + status = nf90_inq_varid( ncid, 'soltsi', varid ) + if ( status == nf90_noerr) then + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,soltsiobs) + else + if (is_first_step()) write(iulog,*)'using column value of soltsi from boundary data as global solar tsi' + end if +!===================================================================== +!get state variables from camiop file + + status = nf90_inq_varid( ncid, 'Tsair', varid ) + if ( status /= nf90_noerr ) then + have_tsair = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,tsair) + have_tsair = .true. + endif +! +! read in Tobs For cam generated iop readin small t to avoid confusion +! with capital T defined in cam +! + tobs(:)= 0._r8 + + if ( use_camiop ) then + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx,'t', have_tsair, & + tsair(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm,tobs, status ) + else + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx,'T', have_tsair, & + tsair(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, tobs, status ) + endif + if ( status /= nf90_noerr ) then + have_t = .false. + if (masterproc) write(iulog,*) sub//':Could not find variable T on IOP file' + if ( scm_backfill_iop_w_init ) then + if (masterproc) write(iulog,*) sub//':Using value of T(tobs) from IC file if it exists' + else + if (masterproc) write(iulog,*) sub//':set tobs to 0.' + endif +! +! set T3 to Tobs on first time step +! + else + have_t = .true. + endif + + status = nf90_inq_varid( ncid, 'Tg', varid ) + if (status /= nf90_noerr) then + if (masterproc) write(iulog,*) sub//':Could not find variable Tg on IOP dataset' + if ( have_tsair ) then + if (masterproc) write(iulog,*) sub//':Using Tsair' + tground = tsair ! use surface value from T field + have_Tg = .true. + else + have_Tg = .true. + if (masterproc) write(iulog,*) sub//':Using T at lowest level from IOP dataset' + tground = tobs(plev) + endif + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,tground) + have_Tg = .true. + endif + + status = nf90_inq_varid( ncid, 'qsrf', varid ) + + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + qobs(:)= 0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'q', have_srf, & + srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, qobs, status ) + if ( status /= nf90_noerr ) then + have_q = .false. + if (masterproc) write(iulog,*) sub//':Could not find variable q on IOP file' + if ( scm_backfill_iop_w_init ) then + if (masterproc) write(iulog,*) sub//':Using values for q from IC file if available' + else + if (masterproc) write(iulog,*) sub//':Setting qobs to 0.' + endif + else + have_q = .true. + endif + + cldobs = 0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'cld', .false., & + dummy, fill_ends, scm_crm_mode, dplevs, nlev,psobs, hyam, hybm, cldobs, status ) + if ( status /= nf90_noerr ) then + have_cld = .false. + else + have_cld = .true. + endif + + clwpobs = 0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'clwp', .false., & + dummy, fill_ends, scm_crm_mode, dplevs, nlev,psobs, hyam, hybm, clwpobs, status ) + if ( status /= nf90_noerr ) then + have_clwp = .false. + else + have_clwp = .true. + endif + +! +! read divq (horizontal advection) +! + status = nf90_inq_varid( ncid, 'divqsrf', varid ) + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + divq(:,:)=0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & + 'divq', have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, divq(:,1), status ) + if ( status /= nf90_noerr ) then + have_divq = .false. + else + have_divq = .true. + endif + +! +! read vertdivq if available +! + status = nf90_inq_varid( ncid, 'vertdivqsrf', varid ) + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + vertdivq=0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'vertdivq', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, vertdivq(:,1), status ) + if ( status /= nf90_noerr ) then + have_vertdivq = .false. + else + have_vertdivq = .true. + endif + + status = nf90_inq_varid( ncid, 'vertdivqsrf', varid ) + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif +! +! add calls to get dynamics tendencies for all prognostic consts +! + divq3d=0._r8 + + do m = 1, pcnst + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, trim(cnst_name(m))//'_dten', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, divq3d(:,m), status ) + write(iulog,*)'checking ',trim(cnst_name(m))//'_dten',status + if ( status /= nf90_noerr ) then + have_cnst(m) = .false. + divq3d(1:,m)=0._r8 + else + if (m==1) have_divq3d = .true. + have_cnst(m) = .true. + endif + + coldata = 0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, trim(cnst_name(m))//'_dqfx', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, coldata, status ) + if ( STATUS /= NF90_NOERR ) then + dqfxcam(1,:,m)=0._r8 + else + dqfxcam(1,:,m)=coldata(:) + endif + + tmpdata = 0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, trim(cnst_name(m))//'_alph', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, tmpdata, status ) + if ( status /= nf90_noerr ) then + alphacam(m)=0._r8 + else + alphacam(m)=tmpdata(1) + endif + + end do + + + numliqobs = 0._r8 + call cnst_get_ind('NUMLIQ', inumliq, abort=.false.) + if ( inumliq > 0 ) then + have_srf = .false. + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'NUMLIQ', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, numliqobs, status ) + if ( status /= nf90_noerr ) then + have_numliq = .false. + else + have_numliq = .true. + endif + else + have_numliq = .false. + end if + + have_srf = .false. + + cldliqobs = 0._r8 + call cnst_get_ind('CLDLIQ', icldliq, abort=.false.) + if ( icldliq > 0 ) then + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'CLDLIQ', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, cldliqobs, status ) + if ( status /= nf90_noerr ) then + have_cldliq = .false. + else + have_cldliq = .true. + endif + else + have_cldliq = .false. + endif + + cldiceobs = 0._r8 + call cnst_get_ind('CLDICE', icldice, abort=.false.) + if ( icldice > 0 ) then + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'CLDICE', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, cldiceobs, status ) + if ( status /= nf90_noerr ) then + have_cldice = .false. + else + have_cldice = .true. + endif + else + have_cldice = .false. + endif + + numiceobs = 0._r8 + call cnst_get_ind('NUMICE', inumice, abort=.false.) + if ( inumice > 0 ) then + have_srf = .false. + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'NUMICE', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, numiceobs, status ) + if ( status /= nf90_noerr ) then + have_numice = .false. + else + have_numice = .true. + endif + else + have_numice = .false. + end if + +! +! read divu (optional field) +! + status = nf90_inq_varid( ncid, 'divusrf', varid ) + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + divu = 0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divu', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, divu, status ) + if ( status /= nf90_noerr ) then + have_divu = .false. + else + have_divu = .true. + endif +! +! read divv (optional field) +! + status = nf90_inq_varid( ncid, 'divvsrf', varid ) + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + divv = 0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divv', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, divv, status ) + if ( status /= nf90_noerr ) then + have_divv = .false. + else + have_divv = .true. + endif +! +! read divt (optional field) +! + status = nf90_inq_varid( ncid, 'divtsrf', varid ) + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + divt=0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & + 'divT', have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, divt, status ) + if ( status /= nf90_noerr ) then + have_divt = .false. + else + have_divt = .true. + endif + +! +! read vertdivt if available +! + status = nf90_inq_varid( ncid, 'vertdivTsrf', varid ) + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + vertdivt=0._r8 + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'vertdivTx', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, vertdivt, status ) + if ( status /= nf90_noerr ) then + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'vertdivT', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, vertdivt, status ) + if ( status /= nf90_noerr ) then + have_vertdivt = .false. + else + have_vertdivt = .true. + endif + else + have_vertdivt = .true. + endif +! +! read divt3d (combined vertical/horizontal advection) +! (optional field) + + status = nf90_inq_varid( ncid, 'divT3dsrf', varid ) + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_srf = .true. + endif + + divT3d = 0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divT3d', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, divt3d, status ) + write(iulog,*)'checking divT3d:',status,nf90_noerr + if ( status /= nf90_noerr ) then + have_divt3d = .false. + else + have_divt3d = .true. + endif + + divU3d = 0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divU3d', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, divu3d, status ) + if ( status /= nf90_noerr ) then + have_divu3d = .false. + else + have_divu3d = .true. + endif + + divV3d = 0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divV3d', & + have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, divv3d, status ) + if ( status /= nf90_noerr ) then + have_divv3d = .false. + else + have_divv3d = .true. + endif + + status = nf90_inq_varid( ncid, 'Ptend', varid ) + if ( status /= nf90_noerr ) then + have_ptend = .false. + if (masterproc) write(iulog,*) sub//':Could not find variable Ptend. Setting to zero' + ptend = 0.0_r8 + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + have_ptend = .true. + ptend= srf(1) + endif + + wfld=0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & + 'omega', .true., ptend, fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, wfld, status ) + if ( status /= nf90_noerr ) then + have_omega = .false. + if (masterproc) write(iulog,*) sub//':Could not find variable omega on IOP' + if ( scm_backfill_iop_w_init ) then + if (masterproc) write(iulog,*) sub//'Using omega from IC file' + else + if (masterproc) write(iulog,*) sub//'setting Omega to 0. throughout the column' + endif + else + have_omega = .true. + endif + call plevs0(plev, psobs, ps0, hyam, hybm, hyai, hybi, pint, pmid ,pdel) +! +! Build interface vector for the specified omega profile +! (weighted average in pressure of specified level values) +! + wfldh(:) = 0.0_r8 + + do k=2,plev + weight = (pint(k) - pmid(k-1))/(pmid(k) - pmid(k-1)) + wfldh(k) = (1.0_r8 - weight)*wfld(k-1) + weight*wfld(k) + end do + + status = nf90_inq_varid( ncid, 'usrf', varid ) + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,srf) + have_srf = .true. + endif + + uobs=0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & + 'u', have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, uobs, status ) + if ( status /= nf90_noerr ) then + have_u = .false. + else + have_u = .true. + endif + + status = nf90_inq_varid( ncid, 'vsrf', varid ) + if ( status /= nf90_noerr ) then + have_srf = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,srf) + have_srf = .true. + endif + + vobs=0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & + 'v', have_srf, srf(1), fill_ends, scm_crm_mode, & + dplevs, nlev,psobs, hyam, hybm, vobs, status ) + if ( status /= nf90_noerr ) then + have_v = .false. + else + have_v = .true. + endif + + status = nf90_inq_varid( ncid, 'Prec', varid ) + if ( status /= nf90_noerr ) then + have_prec = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,precobs) + have_prec = .true. + endif + + q1obs = 0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'Q1', & + .false., dummy, fill_ends, scm_crm_mode, & ! datasets don't contain Q1 at surface + dplevs, nlev,psobs, hyam, hybm, q1obs, status ) + if ( status /= nf90_noerr ) then + have_q1 = .false. + else + have_q1 = .true. + endif + + q1obs = 0._r8 + + call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'Q2', & + .false., dummy, fill_ends, scm_crm_mode, & ! datasets don't contain Q2 at surface + dplevs, nlev,psobs, hyam, hybm, q1obs, status ) + if ( status /= nf90_noerr ) then + have_q2 = .false. + else + have_q2 = .true. + endif + +! Test for BOTH 'lhflx' and 'lh' without overwriting 'have_lhflx'. +! Analagous changes made for the surface heat flux + + status = nf90_inq_varid( ncid, 'lhflx', varid ) + if ( status /= nf90_noerr ) then + status = nf90_inq_varid( ncid, 'lh', varid ) + if ( status /= nf90_noerr ) then + have_lhflx = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,lhflxobs) + have_lhflx = .true. + endif + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,lhflxobs) + have_lhflx = .true. + endif + + status = nf90_inq_varid( ncid, 'shflx', varid ) + if ( status /= nf90_noerr ) then + status = nf90_inq_varid( ncid, 'sh', varid ) + if ( status /= nf90_noerr ) then + have_shflx = .false. + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,shflxobs) + have_shflx = .true. + endif + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,shflxobs) + have_shflx = .true. + endif + + ! If REPLAY is used, then need to read in the global + ! energy fixer + status = nf90_inq_varid( ncid, 'heat_glob', varid ) + if (status /= nf90_noerr) then + have_heat_glob = .false. + else + call wrap_get_vara_realx (ncid,varid,strt4,cnt4,heat_glob_scm) + have_heat_glob = .true. + endif + +! +! fill in 3d forcing variables if we have both horizontal +! and vertical components, but not the 3d +! + if ( .not. have_cnst(1) .and. have_divq .and. have_vertdivq ) then + do k=1,plev + do m=1,pcnst + divq3d(k,m) = divq(k,m) + vertdivq(k,m) + enddo + enddo + have_divq3d = .true. + endif + + if ( .not. have_divt3d .and. have_divt .and. have_vertdivt ) then + if (masterproc) write(iulog,*) sub//'Don''t have divt3d - using divt and vertdivt' + do k=1,plev + divt3d(k) = divt(k) + vertdivt(k) + enddo + have_divt3d = .true. + endif +! +! make sure that use_3dfrc flag is set to true if we only have +! 3d forcing available +! + if (scm_use_3dfrc) then + if (have_divt3d .and. have_divq3d) then + use_3dfrc = .true. + else + call endrun(sub//':ERROR :IOP file must have both divt3d and divq3d forcing when scm_use_3dfrc is set to .true.') + endif + endif + + status = nf90_inq_varid( ncid, 'beta', varid ) + if ( status /= nf90_noerr ) then + betacam = 0._r8 + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + betacam=srf(1) + endif + + status = nf90_inq_varid( ncid, 'fixmas', varid ) + if ( status /= nf90_noerr ) then + fixmascam=1.0_r8 + else + call get_start_count(ncid, varid, scmlat, scmlon, ioptimeidx, strt4, cnt4) + status = nf90_get_var(ncid, varid, srf(1), strt4) + fixmascam=srf(1) + endif + + status = nf90_close( ncid ) + + deallocate(dplevs) + +end subroutine readiopdata + +subroutine setiopupdate + +!----------------------------------------------------------------------- +! +! Open and read netCDF file to extract time information +! +!---------------------------Code history-------------------------------- +! +! Written by John Truesdale August, 1996 +! +!----------------------------------------------------------------------- + implicit none + + character(len=*), parameter :: sub = "setiopupdate" + +!------------------------------Locals----------------------------------- + + integer :: next_date, next_sec + integer :: ncsec,ncdate ! current time of day,date + integer :: yr, mon, day ! year, month, and day component +!------------------------------------------------------------------------------ + + call get_curr_date(yr,mon,day,ncsec) + ncdate=yr*10000 + mon*100 + day + +!------------------------------------------------------------------------------ +! Check if iop data needs to be updated and set doiopupdate accordingly +!------------------------------------------------------------------------------ + + if ( is_first_step() ) then + doiopupdate = .true. + + else + + call timemgr_time_inc(bdate, 0, next_date, next_sec, inc_s=tsec(iopTimeIdx+1)) + if ( ncdate > next_date .or. (ncdate == next_date & + .and. ncsec >= next_sec)) then + doiopupdate = .true. + ! check to see if we need to move iopindex ahead more than 1 step + do while ( ncdate > next_date .or. (ncdate == next_date .and. ncsec >= next_sec)) + iopTimeIdx = iopTimeIdx + 1 + call timemgr_time_inc(bdate, 0, next_date, next_sec, inc_s=tsec(iopTimeIdx+1)) + end do +#if DEBUG > 2 + if (masterproc) write(iulog,*) sub//'nstep = ',get_nstep() + if (masterproc) write(iulog,*) sub//'ncdate=',ncdate,' ncsec=',ncsec + if (masterproc) write(iulog,*) sub//'next_date=',next_date,' next_sec=',next_sec + if (masterproc) write(iulog,*) sub//':******* do iop update' +#endif + else + doiopupdate = .false. + end if + endif ! if (endstep = 1 ) +! +! make sure we're +! not going past end of iop data +! + if ( ncdate > last_date .or. (ncdate == last_date & + .and. ncsec > last_sec)) then + call endrun(sub//':ERROR: Reached the end of the time varient dataset') + endif + +#if DEBUG > 1 + if (masterproc) write(iulog,*) sub//':iop time index = ' , ioptimeidx +#endif + +end subroutine setiopupdate !=============================================================================== +subroutine plevs0 (nver, ps, ps0, hyam, hybm, hyai, hybi, pint ,pmid ,pdel) + +!----------------------------------------------------------------------- +! +! Purpose: +! Define the pressures of the interfaces and midpoints from the +! coordinate definitions and the surface pressure. +! +! Author: B. Boville +! +!----------------------------------------------------------------------- + implicit none + + +!----------------------------------------------------------------------- + integer , intent(in) :: nver ! vertical dimension + real(r8), intent(in) :: ps ! Surface pressure (pascals) + real(r8), intent(in) :: ps0 ! reference pressure (pascals) + real(r8), intent(in) :: hyam(plev) ! hybrid midpoint coef + real(r8), intent(in) :: hybm(plev) ! hybrid midpoint coef + real(r8), intent(in) :: hyai(plevp) ! hybrid interface coef + real(r8), intent(in) :: hybi(plevp) ! hybrid interface coef + real(r8), intent(out) :: pint(nver+1) ! Pressure at model interfaces + real(r8), intent(out) :: pmid(nver) ! Pressure at model levels + real(r8), intent(out) :: pdel(nver) ! Layer thickness (pint(k+1) - pint(k)) +!----------------------------------------------------------------------- + +!---------------------------Local workspace----------------------------- + integer :: k ! Longitude, level indices +!----------------------------------------------------------------------- +! +! Set interface pressures +! +!$OMP PARALLEL DO PRIVATE (K) + do k=1,nver+1 + pint(k) = hyai(k)*ps0 + hybi(k)*ps + end do +! +! Set midpoint pressures and layer thicknesses +! +!$OMP PARALLEL DO PRIVATE (K) + do k=1,nver + pmid(k) = hyam(k)*ps0 + hybm(k)*ps + pdel(k) = pint(k+1) - pint(k) + end do + +end subroutine plevs0 + +subroutine scmiop_flbc_inti ( co2vmr, ch4vmr, n2ovmr, f11vmr, f12vmr ) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Get start count for variable + ! + !----------------------------------------------------------------------- + + implicit none + + real(r8), intent(out) :: co2vmr, ch4vmr, n2ovmr, f11vmr, f12vmr + + !----------------------------------------------------------------------- + + co2vmr=co2vmrobs(1) + ch4vmr=ch4vmrobs(1) + n2ovmr=n2ovmrobs(1) + f11vmr=f11vmrobs(1) + f12vmr=f12vmrobs(1) +end subroutine scmiop_flbc_inti + +subroutine get_start_count (ncid ,varid ,scmlat, scmlon, timeidx, start ,count) + + !----------------------------------------------------------------------- + ! + ! Purpose: + ! set global lower boundary conditions + ! + !----------------------------------------------------------------------- + + implicit none + + character(len=*), parameter :: sub = "get_start_count" + +!----------------------------------------------------------------------- + integer , intent(in) :: ncid ! file id + integer , intent(in) :: varid ! variable id + integer , intent(in) :: TimeIdx ! time index + real(r8), intent(in) :: scmlat,scmlon! scm lat/lon + integer , intent(out) :: start(:),count(:) + +!---------------------------Local workspace----------------------------- + integer :: dims_set,nlev,var_ndims + logical :: usable_var + character(len=cl) :: dim_name + integer :: var_dimIDs( NF90_MAX_VAR_DIMS ) + real(r8) :: closelat,closelon + integer :: latidx,lonidx,status,i +!----------------------------------------------------------------------- + + call shr_scam_GetCloseLatLon(ncid,scmlat,scmlon,closelat,closelon,latidx,lonidx) + + STATUS = NF90_INQUIRE_VARIABLE( NCID, varID, ndims=var_ndims ) +! +! surface variables +! + if ( var_ndims == 0 ) then + call endrun(sub//':ERROR: var_ndims is 0 for varid:',varid) + endif + + STATUS = NF90_INQUIRE_VARIABLE( NCID, varID, dimids=var_dimIDs) + if ( STATUS /= NF90_NOERR ) then + write(iulog,* ) sub//'ERROR - Cant get dimension IDs for varid', varid + call endrun(sub//':ERROR: Cant get dimension IDs for varid',varid) + endif +! +! Initialize the start and count arrays +! + dims_set = 0 + nlev = 1 + do i = var_ndims, 1, -1 + + usable_var = .false. + STATUS = NF90_INQUIRE_DIMENSION( NCID, var_dimIDs( i ), dim_name ) + + if ( trim(dim_name) == 'lat' ) then + start( i ) = latIdx + count( i ) = 1 ! Extract a single value + dims_set = dims_set + 1 + usable_var = .true. + endif + + if ( trim(dim_name) == 'lon' .or. trim(dim_name) == 'ncol' .or. trim(dim_name) == 'ncol_d' ) then + start( i ) = lonIdx + count( i ) = 1 ! Extract a single value + dims_set = dims_set + 1 + usable_var = .true. + endif + + if ( trim(dim_name) == 'lev' ) then + STATUS = NF90_INQUIRE_DIMENSION( NCID, var_dimIDs( i ), len=nlev ) + start( i ) = 1 + count( i ) = nlev ! Extract all levels + dims_set = dims_set + 1 + usable_var = .true. + endif + + if ( trim(dim_name) == 'ilev' ) then + STATUS = NF90_INQUIRE_DIMENSION( NCID, var_dimIDs( i ), len=nlev ) + start( i ) = 1 + count( i ) = nlev ! Extract all levels + dims_set = dims_set + 1 + usable_var = .true. + endif + + if ( trim(dim_name) == 'time' .OR. trim(dim_name) == 'tsec' ) then + start( i ) = TimeIdx + count( i ) = 1 ! Extract a single value + dims_set = dims_set + 1 + usable_var = .true. + endif + end do + end subroutine get_start_count + +!========================================================================= +subroutine setiopupdate_init + +!----------------------------------------------------------------------- +! +! Open and read netCDF file to extract time information +! This subroutine should be called at the first SCM time step +! +!---------------------------Code history-------------------------------- +! +! Written by John Truesdale August, 1996 +! Modified for E3SM by Peter Bogenschutz 2017 - onward +! +!----------------------------------------------------------------------- + implicit none + +!------------------------------Locals----------------------------------- + + integer :: NCID,i + integer :: tsec_varID, time_dimID + integer :: bdate_varID + integer :: STATUS + integer :: next_date, next_sec + integer :: ncsec,ncdate ! current time of day,date + integer :: yr, mon, day ! year, month, and day component + integer :: start_ymd,start_tod + + character(len=*), parameter :: sub = "setiopupdate_init" +!!------------------------------------------------------------------------------ + + ! Open and read pertinent information from the IOP file + + call handle_ncerr( nf90_open (iopfile, 0, ncid),& + 'ERROR - scamMod.F90:setiopupdate_init Failed to open iop file', __LINE__) + + ! Read time (tsec) variable + + STATUS = NF90_INQ_VARID( NCID, 'tsec', tsec_varID ) + if ( STATUS /= NF90_NOERR ) then + write(iulog,*)sub//':ERROR: Cant get variable ID for tsec' + STATUS = NF90_CLOSE ( NCID ) + call endrun(sub//':ERROR: Cant get variable ID for tsec') + end if + + STATUS = NF90_INQ_VARID( NCID, 'bdate', bdate_varID ) + if ( STATUS /= NF90_NOERR ) then + STATUS = NF90_INQ_VARID( NCID, 'basedate', bdate_varID ) + if ( STATUS /= NF90_NOERR ) then + write(iulog,*)'ERROR - setiopupdate:Cant get variable ID for base date' + STATUS = NF90_CLOSE ( NCID ) + call endrun(sub//':ERROR: Cant get variable ID for base date') + endif + endif + + STATUS = NF90_INQ_DIMID( NCID, 'time', time_dimID ) + if ( STATUS /= NF90_NOERR ) then + STATUS = NF90_INQ_DIMID( NCID, 'tsec', time_dimID ) + if ( STATUS /= NF90_NOERR ) then + write(iulog,* )'ERROR - setiopupdate:Could not find variable dim ID for time' + STATUS = NF90_CLOSE ( NCID ) + call endrun(sub//':ERROR:Could not find variable dim ID for time') + end if + end if + + if ( STATUS /= NF90_NOERR ) & + write(iulog,*)'ERROR - setiopupdate:Cant get variable dim ID for time' + + STATUS = NF90_INQUIRE_DIMENSION( NCID, time_dimID, len=ntime ) + if ( STATUS /= NF90_NOERR )then + write(iulog,*)'ERROR - setiopupdate:Cant get time dimlen' + endif + + if (.not.allocated(tsec)) allocate(tsec(ntime)) + + STATUS = NF90_GET_VAR( NCID, tsec_varID, tsec ) + if ( STATUS /= NF90_NOERR )then + write(iulog,*)'ERROR - setiopupdate:Cant get variable tsec' + endif + STATUS = NF90_GET_VAR( NCID, bdate_varID, bdate ) + if ( STATUS /= NF90_NOERR )then + write(iulog,*)'ERROR - setiopupdate:Cant get variable bdate' + endif + + ! Close the netCDF file + STATUS = NF90_CLOSE( NCID ) + + ! determine the last date in the iop dataset + + call timemgr_time_inc(bdate, 0, last_date, last_sec, inc_s=tsec(ntime)) + + ! set the iop dataset index + iopTimeIdx=0 + do i=1,ntime ! set the first ioptimeidx + call timemgr_time_inc(bdate, 0, next_date, next_sec, inc_s=tsec(i)) + call get_start_date(yr,mon,day,start_tod) + start_ymd = yr*10000 + mon*100 + day + + if ( start_ymd > next_date .or. (start_ymd == next_date & + .and. start_tod >= next_sec)) then + iopTimeIdx = i + endif + enddo + + call get_curr_date(yr,mon,day,ncsec) + ncdate=yr*10000 + mon*100 + day + + if (iopTimeIdx == 0.or.iopTimeIdx >= ntime) then + call timemgr_time_inc(bdate, 0, next_date, next_sec, inc_s=tsec(1)) + write(iulog,*) 'Error::setiopupdate: Current model time does not fall within IOP period' + write(iulog,*) ' Current CAM Date is ',ncdate,' and ',ncsec,' seconds' + write(iulog,*) ' IOP start is ',next_date,' and ',next_sec,'seconds' + write(iulog,*) ' IOP end is ',last_date,' and ',last_sec,'seconds' + call endrun(sub//':ERROR: Current model time does not fall within IOP period') + endif + + doiopupdate = .true. + +end subroutine setiopupdate_init + end module scamMod diff --git a/src/cpl/nuopc/atm_import_export.F90 b/src/cpl/nuopc/atm_import_export.F90 index baadd00865..b3e16bee8c 100644 --- a/src/cpl/nuopc/atm_import_export.F90 +++ b/src/cpl/nuopc/atm_import_export.F90 @@ -25,7 +25,7 @@ module atm_import_export use srf_field_check , only : set_active_Faxa_nhx use srf_field_check , only : set_active_Faxa_noy use srf_field_check , only : active_Faxa_nhx, active_Faxa_noy - use atm_stream_ndep , only : stream_ndep_init, stream_ndep_interp, stream_ndep_is_initialized + use atm_stream_ndep , only : stream_ndep_init, stream_ndep_interp, stream_ndep_is_initialized, use_ndep_stream implicit none private ! except @@ -199,7 +199,8 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) call set_active_Faxa_nhx(.true.) call set_active_Faxa_noy(.true.) else - ! The following is used for reading in stream data + ! The following is used for reading in stream data, or for aquaplanet or simple model + ! cases where the ndep fluxes are not used. call set_active_Faxa_nhx(.false.) call set_active_Faxa_noy(.false.) end if @@ -245,6 +246,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 +770,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 @@ -1092,25 +1119,51 @@ subroutine export_fields( gcomp, model_mesh, model_clock, cam_out, rc) end do end if - ! If ndep fields are not computed in cam and must be obtained from the ndep input stream call state_getfldptr(exportState, 'Faxa_ndep', fldptr2d=fldptr_ndep, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (.not. active_Faxa_nhx .and. .not. active_Faxa_noy) then + + ! ndep fields not active (i.e., not computed by WACCM). Either they are not needed, + ! or they are obtained from the ndep input stream. + + ! The ndep_stream_nl namelist group is read in stream_ndep_init. This sets whether + ! or not the stream will be used. if (.not. stream_ndep_is_initialized) then call stream_ndep_init(model_mesh, model_clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return stream_ndep_is_initialized = .true. end if - call stream_ndep_interp(cam_out, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! NDEP read from forcing is expected to be in units of gN/m2/sec - but the mediator - ! expects units of kgN/m2/sec - scale_ndep = .001_r8 + + if (use_ndep_stream) then + + ! get ndep fluxes from the stream + call stream_ndep_interp(cam_out, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! NDEP read from forcing is expected to be in units of gN/m2/sec - but the mediator + ! expects units of kgN/m2/sec + scale_ndep = .001_r8 + + else + + ! ndep fluxes not used. Set to zero. + do c = begchunk,endchunk + do i = 1,get_ncols_p(c) + cam_out(c)%nhx_nitrogen_flx(i) = 0._r8 + cam_out(c)%noy_nitrogen_flx(i) = 0._r8 + end do + end do + scale_ndep = 1._r8 + + end if + else + ! If waccm computes ndep, then its in units of kgN/m2/s - and the mediator expects ! units of kgN/m2/sec, so the following conversion needs to happen scale_ndep = 1._r8 + end if + g = 1 do c = begchunk,endchunk do i = 1,get_ncols_p(c) diff --git a/src/cpl/nuopc/atm_stream_ndep.F90 b/src/cpl/nuopc/atm_stream_ndep.F90 index 394808a529..a1d4530722 100644 --- a/src/cpl/nuopc/atm_stream_ndep.F90 +++ b/src/cpl/nuopc/atm_stream_ndep.F90 @@ -26,6 +26,10 @@ module atm_stream_ndep private :: stream_ndep_check_units ! Check the units and make sure they can be used + ! The ndep stream is not needed for aquaplanet or simple model configurations. It + ! is disabled by setting the namelist variable stream_ndep_data_filename to blank. + logical, public, protected :: use_ndep_stream = .true. + type(shr_strdata_type) :: sdat_ndep ! input data stream logical, public :: stream_ndep_is_initialized = .false. character(len=CS) :: stream_varlist_ndep(2) @@ -113,6 +117,17 @@ subroutine stream_ndep_init(model_mesh, model_clock, rc) call mpi_bcast(stream_ndep_year_align, 1, mpi_integer, 0, mpicom, ierr) if (ierr /= 0) call endrun(trim(subname)//": FATAL: mpi_bcast: stream_ndep_year_align") + ! Check whether the stream is being used. + if (stream_ndep_data_filename == ' ') then + use_ndep_stream = .false. + if (masterproc) then + write(iulog,'(a)') ' ' + write(iulog,'(a)') 'NDEP STREAM IS NOT USED.' + write(iulog,'(a)') ' ' + endif + return + endif + if (masterproc) then write(iulog,'(a)' ) ' ' write(iulog,'(a,i8)') 'stream ndep settings:' diff --git a/src/dynamics/eul/diag_dynvar_ic.F90 b/src/dynamics/eul/diag_dynvar_ic.F90 index c963605fe6..f7e20c3df9 100644 --- a/src/dynamics/eul/diag_dynvar_ic.F90 +++ b/src/dynamics/eul/diag_dynvar_ic.F90 @@ -1,15 +1,15 @@ subroutine diag_dynvar_ic(phis, ps, t3, u3, v3, q3) ! -!----------------------------------------------------------------------- -! +!----------------------------------------------------------------------- +! ! Purpose: record state variables to IC file ! !----------------------------------------------------------------------- ! use shr_kind_mod, only: r8 => shr_kind_r8 use pmgrid - use cam_history , only: outfld, write_inithist + use cam_history , only: outfld, write_inithist, write_camiop use constituents, only: pcnst, cnst_name use commap, only:clat,clon use dyn_grid, only : get_horiz_grid_d @@ -44,16 +44,16 @@ subroutine diag_dynvar_ic(phis, ps, t3, u3, v3, q3) call outfld('T&IC ' , t3 (1,1,lat), plon, lat) call outfld('U&IC ' , u3 (1,1,lat), plon, lat) call outfld('V&IC ' , v3 (1,1,lat), plon, lat) -#if (defined BFB_CAM_SCAM_IOP) - clat_plon(:)=clat(lat) - call outfld('CLAT1&IC ', clat_plon, plon, lat) - call outfld('CLON1&IC ', clon, plon, lat) - call get_horiz_grid_d(plat, clat_d_out=phi) - call get_horiz_grid_d(plon, clon_d_out=lam) - clat_plon(:)=phi(lat) - call outfld('LAM&IC ', lam, plon, lat) - call outfld('PHI&IC ', clat_plon, plon, lat) -#endif + if (write_camiop) then + clat_plon(:)=clat(lat) + call outfld('CLAT1&IC ', clat_plon, plon, lat) + call outfld('CLON1&IC ', clon, plon, lat) + call get_horiz_grid_d(plat, clat_d_out=phi) + call get_horiz_grid_d(plon, clon_d_out=lam) + clat_plon(:)=phi(lat) + call outfld('LAM&IC ', lam, plon, lat) + call outfld('PHI&IC ', clat_plon, plon, lat) + end if do m=1,pcnst call outfld(trim(cnst_name(m))//'&IC', q3(1,1,m,lat), plon, lat) diff --git a/src/dynamics/eul/dyn_comp.F90 b/src/dynamics/eul/dyn_comp.F90 index 442c9f3228..bb753fdd33 100644 --- a/src/dynamics/eul/dyn_comp.F90 +++ b/src/dynamics/eul/dyn_comp.F90 @@ -11,7 +11,7 @@ module dyn_comp use physconst, only: pi use pmgrid, only: plon, plat, plev, plevp, plnlv, beglat, endlat -use commap, only: clat, clon +use commap, only: clat, clon, latdeg use dyn_grid, only: ptimelevels @@ -32,7 +32,7 @@ module dyn_comp use scamMod, only: single_column, use_camiop, have_u, have_v, & have_cldliq, have_cldice, loniop, latiop, scmlat, scmlon, & - qobs,tobs,scm_cambfb_mode + qobs,tobs,scm_cambfb_mode,uobs,vobs,psobs use cam_pio_utils, only: clean_iodesc_list, cam_pio_get_var use pio, only: file_desc_t, pio_noerr, pio_inq_varid, pio_get_att, & @@ -221,9 +221,6 @@ subroutine dyn_init(dyn_in, dyn_out) use scamMod, only: single_column #if (defined SPMD) use spmd_dyn, only: spmdbuf -#endif -#if (defined BFB_CAM_SCAM_IOP ) - use history_defaults, only: initialize_iop_history #endif use dyn_tests_utils, only: vc_dycore, vc_moist_pressure,string_vc, vc_str_lgth ! Arguments are not used in this dycore, included for compatibility @@ -258,10 +255,6 @@ subroutine dyn_init(dyn_in, dyn_out) call set_phis() if (initial_run) then - -#if (defined BFB_CAM_SCAM_IOP ) - call initialize_iop_history() -#endif call read_inidat() call clean_iodesc_list() end if @@ -367,8 +360,9 @@ subroutine read_inidat() use ncdio_atm, only: infld - use iop, only: setiopupdate,readiopdata - + use scamMod, only: setiopupdate,setiopupdate_init,readiopdata + use iop, only: iop_update_prognostics + use hycoef, only: hyam, hybm, hyai, hybi, ps0 ! Local variables integer i,c,m,n,lat ! indices @@ -529,6 +523,7 @@ subroutine read_inidat() deallocate ( phis_tmp ) if (single_column) then + call setiopupdate_init() if ( scm_cambfb_mode ) then fieldname = 'CLAT1' @@ -537,8 +532,9 @@ subroutine read_inidat() if (.not. readvar) then call endrun('CLAT not on iop initial file') else - clat(:) = clat2d(1,:) - clat_p(:)=clat(:) + clat = clat2d(1,1) + clat_p(:)=clat2d(1,1) + latdeg(1) = clat(1)*45._r8/atan(1._r8) end if fieldname = 'CLON1' @@ -582,11 +578,8 @@ subroutine read_inidat() loniop(1)=(mod(scmlon-2.0_r8+360.0_r8,360.0_r8))*pi/180.0_r8 loniop(2)=(mod(scmlon+2.0_r8+360.0_r8,360.0_r8))*pi/180.0_r8 call setiopupdate() - ! readiopdata will set all n1 level prognostics to iop value timestep 0 - call readiopdata(timelevel=1) - ! set t3, and q3(n1) values from iop on timestep 0 - t3(1,:,1,1) = tobs - q3(1,:,1,1,1) = qobs + call readiopdata(hyam,hybm,hyai,hybi,ps0) + call iop_update_prognostics(1,t3=t3,u3=u3,v3=v3,q3=q3,ps=ps) end if end if @@ -608,7 +601,7 @@ subroutine set_phis() ! Local variables type(file_desc_t), pointer :: fh_topo - + integer :: ierr, pio_errtype integer :: lonid, latid integer :: mlon, morec ! lon/lat dimension lengths from topo file @@ -628,7 +621,7 @@ subroutine set_phis() readvar = .false. - if (associated(fh_topo)) then + if (associated(fh_topo)) then call pio_seterrorhandling(fh_topo, PIO_BCAST_ERROR, pio_errtype) diff --git a/src/dynamics/eul/dyn_grid.F90 b/src/dynamics/eul/dyn_grid.F90 index e8cd67b0a0..62d3d73f0c 100644 --- a/src/dynamics/eul/dyn_grid.F90 +++ b/src/dynamics/eul/dyn_grid.F90 @@ -17,6 +17,7 @@ module dyn_grid use cam_abortutils, only: endrun use cam_logfile, only: iulog +use shr_const_mod, only: SHR_CONST_PI, SHR_CONST_REARTH #if (defined SPMD) use spmd_dyn, only: spmdinit_dyn @@ -54,6 +55,8 @@ module dyn_grid integer, parameter, public :: ptimelevels = 3 ! number of time levels in the dycore +real(r8), parameter :: rad2deg = 180._r8/SHR_CONST_PI + integer :: ngcols_d = 0 ! number of dynamics columns !======================================================================================== @@ -73,7 +76,7 @@ subroutine dyn_grid_init latdeg, londeg, xm use time_manager, only: get_step_size use scamMod, only: scmlat, scmlon, single_column - use hycoef, only: hycoef_init, hypi, hypm, hypd, nprlev + use hycoef, only: hycoef_init, hypi, hypm, hypd, nprlev, hyam,hybm,hyai,hybi,ps0 use ref_pres, only: ref_pres_init use eul_control_mod, only: ifax, trig, eul_nsplit @@ -863,7 +866,6 @@ end function get_dyn_grid_parm !------------------------------------------------------------------------------- subroutine dyn_grid_find_gcols( lat, lon, nclosest, owners, indx, jndx, rlat, rlon, idyn_dists ) use spmd_utils, only: iam - use shr_const_mod, only: SHR_CONST_PI, SHR_CONST_REARTH use pmgrid, only: plon, plat real(r8), intent(in) :: lat @@ -886,7 +888,6 @@ subroutine dyn_grid_find_gcols( lat, lon, nclosest, owners, indx, jndx, rlat, rl real(r8), allocatable :: clat_d(:), clon_d(:), distmin(:) integer, allocatable :: igcol(:) - real(r8), parameter :: rad2deg = 180._r8/SHR_CONST_PI latr = lat/rad2deg lonr = lon/rad2deg diff --git a/src/dynamics/eul/dynpkg.F90 b/src/dynamics/eul/dynpkg.F90 index 94fcec48f9..0d3a2810f7 100644 --- a/src/dynamics/eul/dynpkg.F90 +++ b/src/dynamics/eul/dynpkg.F90 @@ -1,14 +1,14 @@ subroutine dynpkg (adv_state, t2 ,fu ,fv ,etamid , & cwava ,detam ,flx_net ,ztodt ) -!----------------------------------------------------------------------- -! -! Purpose: +!----------------------------------------------------------------------- +! +! Purpose: ! Driving routines for dynamics and transport. -! -! Method: -! -! Author: +! +! Method: +! +! Author: ! Original version: CCM3 ! !----------------------------------------------------------------------- @@ -20,10 +20,9 @@ subroutine dynpkg (adv_state, t2 ,fu ,fv ,etamid , & use scanslt, only: scanslt_run, plond, platd, advection_state use scan2, only: scan2run use scamMod, only: single_column,scm_crm_mode,switch,wfldh -#if ( defined BFB_CAM_SCAM_IOP ) use iop, only: t2sav,fusav,fvsav -#endif use perf_mod + use cam_history, only: write_camiop !----------------------------------------------------------------------- implicit none @@ -36,7 +35,7 @@ subroutine dynpkg (adv_state, t2 ,fu ,fv ,etamid , & real(r8), intent(inout) :: fu(plon,plev,beglat:endlat) ! u wind tendency real(r8), intent(inout) :: fv(plon,plev,beglat:endlat) ! v wind tendency - real(r8), intent(in) :: etamid(plev) ! vertical coords at midpoints + real(r8), intent(in) :: etamid(plev) ! vertical coords at midpoints real(r8), intent(inout) :: cwava(plat) ! weight applied to global integrals real(r8), intent(inout) :: detam(plev) ! intervals between vert full levs. real(r8), intent(in) :: flx_net(plon,beglat:endlat) ! net flux from physics @@ -60,7 +59,7 @@ subroutine dynpkg (adv_state, t2 ,fu ,fv ,etamid , & real(r8) grd1(2*maxm,plev,plat/2) ! | real(r8) grd2(2*maxm,plev,plat/2) ! | real(r8) grfu1(2*maxm,plev,plat/2) ! |- see quad for definitions - real(r8) grfu2(2*maxm,plev,plat/2) ! | + real(r8) grfu2(2*maxm,plev,plat/2) ! | real(r8) grfv1(2*maxm,plev,plat/2) ! | real(r8) grfv2(2*maxm,plev,plat/2) ! | real(r8) grut1(2*maxm,plev,plat/2) ! | @@ -80,13 +79,13 @@ subroutine dynpkg (adv_state, t2 ,fu ,fv ,etamid , & ! SCANDYN Dynamics scan !---------------------------------------------------------- ! -#if ( defined BFB_CAM_SCAM_IOP ) -do c=beglat,endlat - t2sav(:plon,:,c)= t2(:plon,:,c) - fusav(:plon,:,c)= fu(:plon,:,c) - fvsav(:plon,:,c)= fv(:plon,:,c) -enddo -#endif +if (write_camiop) then + do c=beglat,endlat + t2sav(:plon,:,c)= t2(:plon,:,c) + fusav(:plon,:,c)= fu(:plon,:,c) + fvsav(:plon,:,c)= fv(:plon,:,c) + enddo +end if if ( single_column ) then etadot(1,:,1)=wfldh(:) @@ -150,4 +149,3 @@ subroutine dynpkg (adv_state, t2 ,fu ,fv ,etamid , & return end subroutine dynpkg - diff --git a/src/dynamics/eul/iop.F90 b/src/dynamics/eul/iop.F90 index 24791ad0ed..0754030830 100644 --- a/src/dynamics/eul/iop.F90 +++ b/src/dynamics/eul/iop.F90 @@ -1,43 +1,19 @@ module iop -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- !BOP ! ! !MODULE: iop -! -! !DESCRIPTION: +! +! !DESCRIPTION: ! iop specific routines ! ! !USES: ! use cam_abortutils, only: endrun - use cam_logfile, only: iulog - use constituents, only: readtrace, cnst_get_ind, pcnst, cnst_name + use constituents, only: pcnst use eul_control_mod, only: eul_nsplit - use netcdf, only: NF90_NOERR,NF90_CLOSE,NF90_GET_VAR,NF90_INQUIRE_DIMENSION, & - NF90_INQ_DIMID, NF90_INQ_VARID, NF90_NOWRITE, NF90_OPEN, & - NF90_GET_ATT,NF90_GLOBAL,NF90_INQUIRE_ATTRIBUTE - use phys_control, only: phys_getopts - use pmgrid, only: beglat,endlat,plon,plev,plevp - use prognostics, only: n3,t3,q3,u3,v3,ps - use scamMod, only: use_camiop, ioptimeidx, have_ps, scm_backfill_iop_w_init, have_tsair, & - tobs, have_t, tground, have_tg, qobs, have_q, have_cld, & - have_clwp, divq, have_divq, vertdivq, have_vertdivq, divq3d, & - have_divq3d, dqfxcam, have_numliq, have_cldliq, have_cldice, & - have_numice, have_divu, have_divv, divt, have_divt, vertdivt, & - have_vertdivt, divt3d, have_divt3d, have_divu3d, have_divv3d, & - have_ptend, ptend, wfld, uobs, have_u, uobs, vobs, have_v, & - vobs, have_prec, have_q1, have_q2, have_lhflx, have_shflx, & - use_3dfrc, betacam, fixmascam, alphacam, doiopupdate, & - cldiceobs, cldliqobs, cldobs, clwpobs, divu, & - divu3d, divv, divv3d, iopfile, lhflxobs, numiceobs, numliqobs, & - precobs, q1obs, scmlat, scmlon, shflxobs, tsair, have_omega, wfldh,qinitobs - use shr_kind_mod, only: r8 => shr_kind_r8, max_chars=>shr_kind_cl - use shr_scam_mod, only: shr_scam_GetCloseLatLon - use spmd_utils, only: masterproc - use string_utils, only: to_lower - use time_manager, only: timemgr_init, get_curr_date, get_curr_calday,& - get_nstep,is_first_step,get_start_date,timemgr_time_inc - use wrap_nf, only: wrap_inq_dimid,wrap_get_vara_realx + use pmgrid, only: beglat,endlat,plon,plev + use shr_kind_mod, only: r8 => shr_kind_r8 ! ! !PUBLIC TYPES: implicit none @@ -45,26 +21,20 @@ module iop private - real(r8), allocatable,target :: dqfx3sav(:,:,:,:) - real(r8), allocatable,target :: t2sav(:,:,:) - real(r8), allocatable,target :: fusav(:,:,:) - real(r8), allocatable,target :: fvsav(:,:,:) + real(r8), allocatable,target :: dqfx3sav(:,:,:,:) + real(r8), allocatable,target :: t2sav(:,:,:) + real(r8), allocatable,target :: fusav(:,:,:) + real(r8), allocatable,target :: fvsav(:,:,:) real(r8), allocatable,target :: divq3dsav(:,:,:,:) - real(r8), allocatable,target :: divt3dsav(:,:,:) - real(r8), allocatable,target :: divu3dsav(:,:,:) - real(r8), allocatable,target :: divv3dsav(:,:,:) + real(r8), allocatable,target :: divt3dsav(:,:,:) + real(r8), allocatable,target :: divu3dsav(:,:,:) + real(r8), allocatable,target :: divv3dsav(:,:,:) real(r8), allocatable,target :: betasav(:) - integer :: closelatidx,closelonidx,latid,lonid,levid,timeid - - real(r8):: closelat,closelon - ! ! !PUBLIC MEMBER FUNCTIONS: public :: init_iop_fields - public :: readiopdata ! read iop boundary data - public :: setiopupdate ! find index in iopboundary data for current time -! public :: scam_use_iop_srf + public :: iop_update_prognostics ! !PUBLIC DATA: public betasav, & dqfx3sav, divq3dsav, divt3dsav,divu3dsav,divv3dsav,t2sav,fusav,fvsav @@ -76,7 +46,7 @@ module iop !EOP ! ! !PRIVATE MEMBER FUNCTIONS: -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- contains subroutine init_iop_fields() @@ -90,7 +60,7 @@ subroutine init_iop_fields() if (eul_nsplit>1) then call endrun('iop module cannot be used with eul_nsplit>1') endif - + if(.not.allocated(betasav)) then allocate (betasav(beglat:endlat)) betasav(:)=0._r8 @@ -130,1026 +100,35 @@ subroutine init_iop_fields() endif end subroutine init_iop_fields -subroutine readiopdata(timelevel) - - -!----------------------------------------------------------------------- -! -! Open and read netCDF file containing initial IOP conditions -! -!---------------------------Code history-------------------------------- -! -! Written by J. Truesdale August, 1996, revised January, 1998 -! -!----------------------------------------------------------------------- - use ppgrid, only: begchunk, endchunk - use phys_grid, only: clat_p - use commap, only: latdeg, clat - use getinterpnetcdfdata, only: getinterpncdata - use shr_sys_mod, only: shr_sys_flush - use hycoef, only: hyam, hybm - use error_messages, only: handle_ncerr -!----------------------------------------------------------------------- - implicit none -#if ( defined RS6000 ) - implicit automatic ( a-z ) -#endif - - character(len=*), parameter :: sub = "read_iop_data" - -!------------------------------Input Arguments-------------------------- -! -integer, optional, intent(in) :: timelevel - -!------------------------------Locals----------------------------------- -! - integer ntimelevel - integer NCID, status - integer time_dimID, lev_dimID, lev_varID - integer tsec_varID, bdate_varID,varid - integer i,j - integer nlev - integer total_levs - integer u_attlen - - integer bdate, ntime,nstep - integer, allocatable :: tsec(:) - integer k, m - integer icldliq,icldice - integer inumliq,inumice,idx - - logical have_srf ! value at surface is available - logical fill_ends ! - logical have_cnst(pcnst) - real(r8) dummy - real(r8) lat,xlat - real(r8) srf(1) ! value at surface - real(r8) pmid(plev) ! pressure at model levels (time n) - real(r8) pint(plevp) ! pressure at model interfaces (n ) - real(r8) pdel(plev) ! pdel(k) = pint (k+1)-pint (k) - real(r8) weight - real(r8) tmpdata(1) - real(r8) coldata(plev) - real(r8), allocatable :: dplevs( : ) - integer strt4(4),cnt4(4),strt5(4),cnt5(4) - character(len=16) :: lowername - character(len=max_chars) :: units ! Units - - nstep = get_nstep() - fill_ends= .false. - - if (present(timelevel)) then - ntimelevel=timelevel - else - ntimelevel=n3 - end if - -! -! Open IOP dataset -! - call handle_ncerr( nf90_open (iopfile, 0, ncid),& - 'readiopdata.F90', __LINE__) - -! -! if the dataset is a CAM generated dataset set use_camiop to true -! CAM IOP datasets have a global attribute called CAM_GENERATED_IOP -! - if ( nf90_inquire_attribute( ncid, NF90_GLOBAL, 'CAM_GENERATED_FORCING', attnum=i )== NF90_NOERR ) then - use_camiop = .true. - else - use_camiop = .false. - endif - -!===================================================================== -! -! Read time variables - - - status = nf90_inq_dimid (ncid, 'time', time_dimID ) - if (status /= NF90_NOERR) then - status = nf90_inq_dimid (ncid, 'tsec', time_dimID ) - if (status /= NF90_NOERR) then - if (masterproc) write(iulog,*) sub//':ERROR - readiopdata.F:Could not find dimension ID for time/tsec' - status = NF90_CLOSE ( ncid ) - call endrun - end if - end if - - call handle_ncerr( nf90_inquire_dimension( ncid, time_dimID, len=ntime ),& - 'readiopdata.F90', __LINE__) - - allocate(tsec(ntime)) - - status = nf90_inq_varid (ncid, 'tsec', tsec_varID ) - call handle_ncerr( nf90_get_var (ncid, tsec_varID, tsec),& - 'readiopdata.F90', __LINE__) - - status = nf90_inq_varid (ncid, 'nbdate', bdate_varID ) - if (status /= NF90_NOERR) then - status = nf90_inq_varid (ncid, 'bdate', bdate_varID ) - if (status /= NF90_NOERR) then - if (masterproc) write(iulog,*) sub//':ERROR - readiopdata.F:Could not find variable ID for bdate' - status = NF90_CLOSE ( ncid ) - call endrun - end if - end if - call handle_ncerr( nf90_get_var (ncid, bdate_varID, bdate),& - 'readiopdata.F90', __LINE__) - -! -!====================================================== -! read level data -! - status = NF90_INQ_DIMID( ncid, 'lev', lev_dimID ) - if ( status .ne. nf90_noerr ) then - if (masterproc) write(iulog,*) sub//':ERROR - readiopdata.F:Could not find variable dim ID for lev' - status = NF90_CLOSE ( ncid ) - return - end if - - call handle_ncerr( nf90_inquire_dimension( ncid, lev_dimID, len=nlev ),& - 'readiopdata.F90', __LINE__) - - allocate(dplevs(nlev+1)) - - status = NF90_INQ_VARID( ncid, 'lev', lev_varID ) - if ( status .ne. nf90_noerr ) then - if (masterproc) write(iulog,*) sub//':ERROR - readiopdata.F:Could not find variable ID for lev' - status = NF90_CLOSE ( ncid ) - return - end if - - call handle_ncerr( nf90_get_var (ncid, lev_varID, dplevs(:nlev)),& - 'readiopdata.F90', __LINE__) -! -!CAM generated forcing already has pressure on millibars convert standard IOP if needed. -! - call handle_ncerr(nf90_inquire_attribute(ncid, lev_varID, 'units', len=u_attlen),& - 'readiopdata.F90', __LINE__) - call handle_ncerr(nf90_get_att(ncid, lev_varID, 'units', units),& - 'readiopdata.F90', __LINE__) - units=trim(to_lower(units(1:u_attlen))) - - if ( units=='pa' .or. units=='pascal' .or. units=='pascals' ) then -! -! convert pressure from Pascals to Millibars ( lev is expressed in pascals in iop datasets ) -! - do i=1,nlev - dplevs( i ) = dplevs( i )/100._r8 - end do - endif - - - call shr_scam_GetCloseLatLon(ncid,scmlat,scmlon,closelat,closelon,closelatidx,closelonidx) - - lonid = 0 - latid = 0 - levid = 0 - timeid = 0 - - call wrap_inq_dimid(ncid, 'lat', latid) - call wrap_inq_dimid(ncid, 'lon', lonid) - call wrap_inq_dimid(ncid, 'lev', levid) - call wrap_inq_dimid(ncid, 'time', timeid) - - strt4(1) = closelonidx - strt4(2) = closelatidx - strt4(3) = iopTimeIdx - strt4(4) = 1 - cnt4(1) = 1 - cnt4(2) = 1 - cnt4(3) = 1 - cnt4(4) = 1 - - status = nf90_inq_varid( ncid, 'Ps', varid ) - if ( status .ne. nf90_noerr ) then - have_ps = .false. - if (masterproc) write(iulog,*) sub//':Could not find variable Ps' - if ( .not. scm_backfill_iop_w_init ) then - status = NF90_CLOSE( ncid ) - return - else - if ( is_first_step() .and. masterproc) write(iulog,*) 'Using pressure value from Analysis Dataset' - endif - else - status = nf90_get_var(ncid, varid, ps(1,1,ntimelevel), strt4) - have_ps = .true. - endif - - -! If the IOP dataset has hyam,hybm,etc it is assumed to be a hybrid level -! dataset. - - status = nf90_inq_varid( ncid, 'hyam', varid ) - if ( status == nf90_noerr ) then - do i = 1, nlev - dplevs( i ) = 1000.0_r8 * hyam( i ) + ps(1,1,ntimelevel) * hybm( i ) / 100.0_r8 - end do - endif - -! add the surface pressure to the pressure level data, so that -! surface boundary condition will be set properly, -! making sure that it is the highest pressure in the array. -! - - total_levs = nlev+1 - dplevs(nlev+1) = ps(1,1,ntimelevel)/100.0_r8 ! ps is expressed in pascals - do i= nlev, 1, -1 - if ( dplevs(i) > ps(1,1,ntimelevel)/100.0_r8) then - total_levs = i - dplevs(i) = ps(1,1,ntimelevel)/100.0_r8 - end if - end do - if (.not. use_camiop ) then - nlev = total_levs - endif - if ( nlev == 1 ) then - if (masterproc) write(iulog,*) sub//':Error - Readiopdata.F: Ps too low!' - return - endif - -!===================================================================== - - - status = nf90_inq_varid( ncid, 'Tsair', varid ) - if ( status .ne. nf90_noerr ) then - have_tsair = .false. - else - call wrap_get_vara_realx (ncid,varid,strt4,cnt4,tsair) - have_tsair = .true. - endif - -! -! read in Tobs For cam generated iop readin small t to avoid confusion -! with capital T defined in cam -! - - tobs(:)= t3(1,:,1,ntimelevel) - - if ( use_camiop ) then - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx,'t', have_tsair, & - tsair(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel),tobs, status ) - else - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx,'T', have_tsair, & - tsair(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), tobs, status ) - endif - if ( status .ne. nf90_noerr ) then - have_t = .false. - if (masterproc) write(iulog,*) sub//':Could not find variable T' - if ( .not. scm_backfill_iop_w_init ) then - status = NF90_CLOSE( ncid ) - return - else - if (masterproc) write(iulog,*) sub//':Using value from Analysis Dataset' - endif -! -! set T3 to Tobs on first time step -! - else - have_t = .true. - endif - - status = nf90_inq_varid( ncid, 'Tg', varid ) - if (status .ne. nf90_noerr) then - if (masterproc) write(iulog,*) sub//':Could not find variable Tg on IOP dataset' - if ( have_tsair ) then - if (masterproc) write(iulog,*) sub//':Using Tsair' - tground = tsair ! use surface value from T field - have_Tg = .true. - else - have_Tg = .true. - if (masterproc) write(iulog,*) sub//':Using T at lowest level from IOP dataset' - tground = tobs(plev) - endif - else - call wrap_get_vara_realx (ncid,varid,strt4,cnt4,tground) - have_Tg = .true. - endif - - status = nf90_inq_varid( ncid, 'qsrf', varid ) - - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - have_srf = .true. - endif - - if (is_first_step()) then - qinitobs(:,:)=q3(1,:,:,1,ntimelevel) - end if - - qobs(:)= q3(1,:,1,1,ntimelevel) - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'q', have_srf, & - srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), qobs, status ) - if ( status .ne. nf90_noerr ) then - have_q = .false. - if (masterproc) write(iulog,*) sub//':Could not find variable q' - if ( .not. scm_backfill_iop_w_init ) then - status = nf90_close( ncid ) - return - else - if (masterproc) write(iulog,*) sub//':Using values from Analysis Dataset' - endif - else - have_q = .true. - endif - - cldobs = 0._r8 - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'cld', .false., & - dummy, fill_ends, dplevs, nlev,ps(1,1,ntimelevel), cldobs, status ) - if ( status .ne. nf90_noerr ) then - have_cld = .false. - else - have_cld = .true. - endif - - clwpobs = 0._r8 - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'clwp', .false., & - dummy, fill_ends, dplevs, nlev,ps(1,1,ntimelevel), clwpobs, status ) - if ( status .ne. nf90_noerr ) then - have_clwp = .false. - else - have_clwp = .true. - endif - -! -! read divq (horizontal advection) -! - status = nf90_inq_varid( ncid, 'divqsrf', varid ) - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - have_srf = .true. - endif - - divq(:,:)=0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & - 'divq', have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), divq(:,1), status ) - if ( status .ne. nf90_noerr ) then - have_divq = .false. - else - have_divq = .true. - endif - -! -! read vertdivq if available -! - status = nf90_inq_varid( ncid, 'vertdivqsrf', varid ) - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - have_srf = .true. - endif - - vertdivq=0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'vertdivq', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), vertdivq(:,1), status ) - if ( status .ne. nf90_noerr ) then - have_vertdivq = .false. - else - have_vertdivq = .true. - endif - - status = nf90_inq_varid( ncid, 'vertdivqsrf', varid ) - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - have_srf = .true. - endif - - -! -! add calls to get dynamics tendencies for all prognostic consts -! - divq3d=0._r8 - - do m = 1, pcnst - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, trim(cnst_name(m))//'_dten', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), divq3d(:,m), status ) - if ( status .ne. nf90_noerr ) then - have_cnst(m) = .false. - divq3d(1:,m)=0._r8 - else - if (m==1) have_divq3d = .true. - have_cnst(m) = .true. - endif - - coldata = 0._r8 - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, trim(cnst_name(m))//'_dqfx', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), coldata, status ) - if ( STATUS .NE. NF90_NOERR ) then - dqfxcam(1,:,m)=0._r8 - else - dqfxcam(1,:,m)=coldata(:) - endif - - tmpdata = 0._r8 - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, trim(cnst_name(m))//'_alph', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), tmpdata, status ) - if ( status .ne. nf90_noerr ) then -! have_cnst(m) = .false. - alphacam(m)=0._r8 - else - alphacam(m)=tmpdata(1) -! have_cnst(m) = .true. - endif - - end do - - - numliqobs = 0._r8 - call cnst_get_ind('NUMLIQ', inumliq, abort=.false.) - if ( inumliq > 0 ) then - have_srf = .false. - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'NUMLIQ', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), numliqobs, status ) - if ( status .ne. nf90_noerr ) then - have_numliq = .false. - else - have_numliq = .true. - do i=1, PLEV - q3(1,i,inumliq,1,ntimelevel)=numliqobs(i) - end do - endif - else - have_numliq = .false. - end if - - have_srf = .false. - - cldliqobs = 0._r8 - call cnst_get_ind('CLDLIQ', icldliq, abort=.false.) - if ( icldliq > 0 ) then - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'CLDLIQ', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), cldliqobs, status ) - if ( status .ne. nf90_noerr ) then - have_cldliq = .false. - else - have_cldliq = .true. - do i=1, PLEV - q3(1,i,icldliq,1,ntimelevel)=cldliqobs(i) - end do - endif - else - have_cldliq = .false. - endif - - cldiceobs = 0._r8 - call cnst_get_ind('CLDICE', icldice, abort=.false.) - if ( icldice > 0 ) then - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'CLDICE', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), cldiceobs, status ) - if ( status .ne. nf90_noerr ) then - have_cldice = .false. - else - have_cldice = .true. - do i=1, PLEV - q3(1,i,icldice,1,ntimelevel)=cldiceobs(i) - end do - endif - else - have_cldice = .false. - endif - - numiceobs = 0._r8 - call cnst_get_ind('NUMICE', inumice, abort=.false.) - if ( inumice > 0 ) then - have_srf = .false. - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'NUMICE', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), numiceobs, status ) - if ( status .ne. nf90_noerr ) then - have_numice = .false. - else - have_numice = .true. - do i=1, PLEV - q3(1,i,inumice,1,ntimelevel)=numiceobs(i) - end do - endif - else - have_numice = .false. - end if - -! -! read divu (optional field) -! - status = nf90_inq_varid( ncid, 'divusrf', varid ) - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - have_srf = .true. - endif - - divu = 0._r8 - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divu', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), divu, status ) - if ( status .ne. nf90_noerr ) then - have_divu = .false. - else - have_divu = .true. - endif -! -! read divv (optional field) -! - status = nf90_inq_varid( ncid, 'divvsrf', varid ) - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - have_srf = .true. - endif - - divv = 0._r8 - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divv', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), divv, status ) - if ( status .ne. nf90_noerr ) then - have_divv = .false. - else - have_divv = .true. - endif -! -! read divt (optional field) -! - status = nf90_inq_varid( ncid, 'divtsrf', varid ) - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - have_srf = .true. - endif - - divt=0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & - 'divT', have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), divt, status ) - if ( status .ne. nf90_noerr ) then - have_divt = .false. - else - have_divt = .true. - endif - -! -! read vertdivt if available -! - status = nf90_inq_varid( ncid, 'vertdivTsrf', varid ) - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - have_srf = .true. - endif - - vertdivt=0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'vertdivT', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), vertdivt, status ) - if ( status .ne. nf90_noerr ) then - have_vertdivt = .false. - else - have_vertdivt = .true. - endif -! -! read divt3d (combined vertical/horizontal advection) -! (optional field) - - status = nf90_inq_varid( ncid, 'divT3dsrf', varid ) - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - have_srf = .true. - endif - - divT3d = 0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divT3d', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), divt3d, status ) - if ( status .ne. nf90_noerr ) then - have_divt3d = .false. - else - have_divt3d = .true. - endif - - divU3d = 0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divU3d', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), divu3d, status ) - if ( status .ne. nf90_noerr ) then - have_divu3d = .false. - else - have_divu3d = .true. - endif - - divV3d = 0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'divV3d', & - have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), divv3d, status ) - if ( status .ne. nf90_noerr ) then - have_divv3d = .false. - else - have_divv3d = .true. - endif - - status = nf90_inq_varid( ncid, 'Ptend', varid ) - if ( status .ne. nf90_noerr ) then - have_ptend = .false. - if (masterproc) write(iulog,*) sub//':Could not find variable Ptend. Setting to zero' - ptend = 0.0_r8 - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - have_ptend = .true. - ptend= srf(1) - endif - - wfld=0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & - 'omega', .true., ptend, fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), wfld, status ) - if ( status .ne. nf90_noerr ) then - have_omega = .false. - if (masterproc) write(iulog,*) sub//':Could not find variable omega' - if ( .not. scm_backfill_iop_w_init ) then - status = nf90_close( ncid ) - return - else - if (masterproc) write(iulog,*) sub//'Using value from Analysis Dataset' - endif - else - have_omega = .true. - endif - call plevs0(1 ,plon ,plev ,ps(1,1,ntimelevel) ,pint,pmid ,pdel) - call shr_sys_flush( iulog ) -! -! Build interface vector for the specified omega profile -! (weighted average in pressure of specified level values) -! - wfldh(:) = 0.0_r8 - - do k=2,plev - weight = (pint(k) - pmid(k-1))/(pmid(k) - pmid(k-1)) - wfldh(k) = (1.0_r8 - weight)*wfld(k-1) + weight*wfld(k) - end do - - status = nf90_inq_varid( ncid, 'usrf', varid ) - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - call wrap_get_vara_realx (ncid,varid,strt4,cnt4,srf) - have_srf = .true. - endif - - uobs=0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & - 'u', have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), uobs, status ) - if ( status .ne. nf90_noerr ) then - have_u = .false. - else - have_u = .true. - do i=1, PLEV - u3(1,i,1,ntimelevel) = uobs(i) ! set u to uobs at first time step - end do - endif - - status = nf90_inq_varid( ncid, 'vsrf', varid ) - if ( status .ne. nf90_noerr ) then - have_srf = .false. - else - call wrap_get_vara_realx (ncid,varid,strt4,cnt4,srf) - have_srf = .true. - endif - - vobs=0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, & - 'v', have_srf, srf(1), fill_ends, & - dplevs, nlev,ps(1,1,ntimelevel), vobs, status ) - if ( status .ne. nf90_noerr ) then - have_v = .false. - else - have_v = .true. - do i=1, PLEV - v3(1,i,1,ntimelevel) = vobs(i) ! set u to uobs at first time step - end do - endif - call shr_sys_flush( iulog ) - - status = nf90_inq_varid( ncid, 'Prec', varid ) - if ( status .ne. nf90_noerr ) then - have_prec = .false. - else - call wrap_get_vara_realx (ncid,varid,strt4,cnt4,precobs) - have_prec = .true. - endif - - q1obs = 0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'Q1', & - .false., dummy, fill_ends, & ! datasets don't contain Q1 at surface - dplevs, nlev,ps(1,1,ntimelevel), q1obs, status ) - if ( status .ne. nf90_noerr ) then - have_q1 = .false. - else - have_q1 = .true. - endif - - q1obs = 0._r8 - - call getinterpncdata( ncid, scmlat, scmlon, ioptimeidx, 'Q2', & - .false., dummy, fill_ends, & ! datasets don't contain Q2 at surface - dplevs, nlev,ps(1,1,ntimelevel), q1obs, status ) - if ( status .ne. nf90_noerr ) then - have_q2 = .false. - else - have_q2 = .true. - endif - -! Test for BOTH 'lhflx' and 'lh' without overwriting 'have_lhflx'. -! Analagous changes made for the surface heat flux - - status = nf90_inq_varid( ncid, 'lhflx', varid ) - if ( status .ne. nf90_noerr ) then - status = nf90_inq_varid( ncid, 'lh', varid ) - if ( status .ne. nf90_noerr ) then - have_lhflx = .false. - else - call wrap_get_vara_realx (ncid,varid,strt4,cnt4,lhflxobs) - have_lhflx = .true. - endif - else - call wrap_get_vara_realx (ncid,varid,strt4,cnt4,lhflxobs) - have_lhflx = .true. - endif - - status = nf90_inq_varid( ncid, 'shflx', varid ) - if ( status .ne. nf90_noerr ) then - status = nf90_inq_varid( ncid, 'sh', varid ) - if ( status .ne. nf90_noerr ) then - have_shflx = .false. - else - call wrap_get_vara_realx (ncid,varid,strt4,cnt4,shflxobs) - have_shflx = .true. - endif - else - call wrap_get_vara_realx (ncid,varid,strt4,cnt4,shflxobs) - have_shflx = .true. - endif - - call shr_sys_flush( iulog ) - -! -! fill in 3d forcing variables if we have both horizontal -! and vertical components, but not the 3d -! - if ( .not. have_cnst(1) .and. have_divq .and. have_vertdivq ) then - do k=1,plev - do m=1,pcnst - divq3d(k,m) = divq(k,m) + vertdivq(k,m) - enddo - enddo - have_divq3d = .true. - endif - - if ( .not. have_divt3d .and. have_divt .and. have_vertdivt ) then - if (masterproc) write(iulog,*) sub//'Don''t have divt3d - using divt and vertdivt' - do k=1,plev - divt3d(k) = divt(k) + vertdivt(k) - enddo - have_divt3d = .true. - endif -! -! make sure that use_3dfrc flag is set to true if we only have -! 3d forcing available -! - if ( .not. have_divt .or. .not. have_divq ) then - use_3dfrc = .true. - endif - call shr_sys_flush( iulog ) - - status = nf90_inq_varid( ncid, 'CLAT', varid ) - if ( status == nf90_noerr ) then - call wrap_get_vara_realx (ncid,varid,strt4,cnt4,clat) - clat_p(1)=clat(1) - latdeg(1) = clat(1)*45._r8/atan(1._r8) - endif - - status = nf90_inq_varid( ncid, 'beta', varid ) - if ( status .ne. nf90_noerr ) then - betacam = 0._r8 - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - betacam=srf(1) - endif - - status = nf90_inq_varid( ncid, 'fixmas', varid ) - if ( status .ne. nf90_noerr ) then - fixmascam=1.0_r8 - else - status = nf90_get_var(ncid, varid, srf(1), strt4) - fixmascam=srf(1) - endif - - call shr_sys_flush( iulog ) - - status = nf90_close( ncid ) - call shr_sys_flush( iulog ) - - deallocate(dplevs,tsec) - - return -end subroutine readiopdata - -subroutine setiopupdate - -!----------------------------------------------------------------------- -! -! Open and read netCDF file to extract time information -! -!---------------------------Code history-------------------------------- -! -! Written by John Truesdale August, 1996 -! -!----------------------------------------------------------------------- - implicit none -#if ( defined RS6000 ) - implicit automatic (a-z) -#endif - character(len=*), parameter :: sub = "setiopupdate" - -!------------------------------Locals----------------------------------- - - integer NCID,i - integer tsec_varID, time_dimID - integer, allocatable :: tsec(:) - integer ntime - integer bdate, bdate_varID - integer STATUS - integer next_date, next_sec, last_date, last_sec - integer :: ncsec,ncdate ! current time of day,date - integer :: yr, mon, day ! year, month, and day component - integer :: start_ymd,start_tod - save tsec, ntime, bdate - save last_date, last_sec + subroutine iop_update_prognostics(timelevel,ps,t3,u3,v3,q3) !------------------------------------------------------------------------------ - - if ( is_first_step() ) then -! -! Open IOP dataset -! - STATUS = NF90_OPEN( iopfile, NF90_NOWRITE, NCID ) -! -! Read time (tsec) variable -! - STATUS = NF90_INQ_VARID( NCID, 'tsec', tsec_varID ) - if ( STATUS .NE. NF90_NOERR .and. masterproc) write(iulog,*) & - sub//':ERROR - setiopupdate.F:', & - 'Cant get variable ID for tsec' - - STATUS = NF90_INQ_VARID( NCID, 'bdate', bdate_varID ) - if ( STATUS .NE. NF90_NOERR ) then - STATUS = NF90_INQ_VARID( NCID, 'basedate', bdate_varID ) - if ( STATUS .NE. NF90_NOERR .and. masterproc) write(iulog,*) & - sub//':ERROR - setiopupdate.F:Cant get variable ID for bdate' - endif - - STATUS = NF90_INQ_DIMID( NCID, 'time', time_dimID ) - if ( STATUS .NE. NF90_NOERR ) then - STATUS = NF90_INQ_DIMID( NCID, 'tsec', time_dimID ) - if ( STATUS .NE. NF90_NOERR ) then - write(iulog,* )'ERROR - setiopupdate.F:Could not find variable dim ID for time' - STATUS = NF90_CLOSE ( NCID ) - return - end if - end if - - if ( STATUS .NE. NF90_NOERR .and. masterproc) write(iulog,*) & - sub//':ERROR - setiopupdate.F:Cant get variable dim ID for time' - - STATUS = NF90_INQUIRE_DIMENSION( NCID, time_dimID, len=ntime ) - if ( STATUS .NE. NF90_NOERR ) then - if (masterproc) write(iulog,*) sub//':ERROR - setiopupdate.F:Cant get time dimlen' - endif - - if (.not.allocated(tsec)) allocate(tsec(ntime)) - - STATUS = NF90_GET_VAR( NCID, tsec_varID, tsec ) - if ( STATUS .NE. NF90_NOERR )then - if (masterproc) write(iulog,*) sub//':ERROR - setiopupdate.F:Cant get variable tsec' - endif - STATUS = NF90_GET_VAR( NCID, bdate_varID, bdate ) - if ( STATUS .NE. NF90_NOERR )then - if (masterproc) write(iulog,*) sub//':ERROR - setiopupdate.F:Cant get variable bdate' - endif -! Close the netCDF file - STATUS = NF90_CLOSE( NCID ) -! -! determine the last date in the iop dataset -! - call timemgr_time_inc(bdate, 0, last_date, last_sec, inc_s=tsec(ntime)) -! -! set the iop dataset index -! - iopTimeIdx=0 - do i=1,ntime ! set the first ioptimeidx - call timemgr_time_inc(bdate, 0, next_date, next_sec, inc_s=tsec(i)) - call get_start_date(yr,mon,day,start_tod) - start_ymd = yr*10000 + mon*100 + day - - if ( start_ymd > next_date .or. (start_ymd == next_date & - .and. start_tod >= next_sec)) then - iopTimeIdx = i - endif - enddo - - call get_curr_date(yr,mon,day,ncsec) - ncdate=yr*10000 + mon*100 + day - - if (iopTimeIdx == 0.or.iopTimeIdx >= ntime) then - call timemgr_time_inc(bdate, 0, next_date, next_sec, inc_s=tsec(1)) - if (masterproc) then - write(iulog,*) 'Error::setiopupdate: Current model time does not fall within IOP period' - write(iulog,*) ' Current CAM Date is ',ncdate,' and ',ncsec,' seconds' - write(iulog,*) ' IOP start is ',next_date,' and ',next_sec,' seconds' - write(iulog,*) ' IOP end is ',last_date,' and ',last_sec,' seconds' - end if - call endrun - endif - - doiopupdate = .true. - +! Copy IOP forcing fields into prognostics which for Eulerian is just PS !------------------------------------------------------------------------------ -! Check if iop data needs to be updated and set doiopupdate accordingly -!------------------------------------------------------------------------------ - else ! endstep > 1 - - call timemgr_time_inc(bdate, 0, next_date, next_sec, inc_s=tsec(iopTimeIdx+1)) - - call get_curr_date(yr, mon, day, ncsec) - ncdate = yr*10000 + mon*100 + day + use scamMod, only: tobs,uobs,vobs,qobs,psobs + implicit none - if ( ncdate > next_date .or. (ncdate == next_date & - .and. ncsec >= next_sec)) then - iopTimeIdx = iopTimeIdx + 1 - doiopupdate = .true. -#if DEBUG > 2 - if (masterproc) write(iulog,*) sub//'nstep = ',get_nstep() - if (masterproc) write(iulog,*) sub//'ncdate=',ncdate,' ncsec=',ncsec - if (masterproc) write(iulog,*) sub//'next_date=',next_date,' next_sec=',next_sec - if (masterproc) write(iulog,*) sub//':******* do iop update' -#endif - else - doiopupdate = .false. - end if - endif ! if (endstep == 0 ) -! -! make sure we're -! not going past end of iop data -! - if ( ncdate > last_date .or. (ncdate == last_date & - .and. ncsec > last_sec)) then - if ( .not. scm_backfill_iop_w_init ) then - call endrun(sub//':ERROR - setiopupdate.c:Reached the end of the time varient dataset') - else - doiopupdate = .false. - end if - endif + !----------------------------------------------------------------------- -#if DEBUG > 1 - if (masterproc) write(iulog,*) sub//':iop time index = ' , ioptimeidx -#endif + integer, intent(in) :: timelevel + real(r8), optional, intent(inout) :: q3(:,:,:,:,:) + real(r8), optional, intent(inout) :: u3(:,:,:,:) + real(r8), optional, intent(inout) :: v3(:,:,:,:) + real(r8), optional, intent(inout) :: t3(:,:,:,:) + real(r8), optional, intent(inout) :: ps(:,:,:) - return +!---------------------------Local workspace----------------------------- + integer :: ioptop + character(len=*), parameter :: sub = "iop_update_prognostics" +!----------------------------------------------------------------------- + ! set prognostics from iop + ! Find level where tobs is no longer zero + ioptop = minloc(tobs(:), 1, BACK=.true.)+1 + if (present(ps)) ps(1,1,timelevel) = psobs + if (present(t3)) t3(1,ioptop:,1,timelevel) = tobs(ioptop:) + if (present(q3)) q3(1,ioptop:,1,1,timelevel) = qobs(ioptop:) + if (present(u3)) u3(1,ioptop:,1,timelevel) = uobs(ioptop:) + if (present(v3)) v3(1,ioptop:,1,timelevel) = vobs(ioptop:) -end subroutine setiopupdate + end subroutine iop_update_prognostics end module iop - diff --git a/src/dynamics/eul/restart_dynamics.F90 b/src/dynamics/eul/restart_dynamics.F90 index 348c2aa26c..dc80678f1b 100644 --- a/src/dynamics/eul/restart_dynamics.F90 +++ b/src/dynamics/eul/restart_dynamics.F90 @@ -9,11 +9,10 @@ module restart_dynamics pdeld, ps, vort, div, & dps, phis, dpsl, dpsm, omga, ptimelevels use scanslt, only: lammp, phimp, sigmp, qfcst -#if ( defined BFB_CAM_SCAM_IOP ) use iop, only: dqfx3sav,divq3dsav,divt3dsav,t2sav,betasav,fusav,fvsav -#endif use cam_logfile, only: iulog use spmd_utils, only: masterproc + use cam_history, only: write_camiop implicit none private @@ -125,7 +124,7 @@ subroutine init_restart_varlist() vcnt=vcnt+1 call set_r_var('PDELD', ptimelevels, vcnt, v4=pdeld ) - + vcnt=vcnt+1 call set_r_var('LAMMP', 1, vcnt, v3=lammp ) @@ -138,32 +137,32 @@ subroutine init_restart_varlist() call set_r_var('Q_fcst', 1, vcnt, v4=qfcst ) -#if ( defined BFB_CAM_SCAM_IOP ) -! -! Write scam values -! - vcnt=vcnt+1 - call set_r_var('DQFX', 1, vcnt, v4=dqfx3sav ) + if (write_camiop) then + ! + ! Write scam values + ! + vcnt=vcnt+1 + call set_r_var('DQFX', 1, vcnt, v4=dqfx3sav ) - vcnt=vcnt+1 - call set_r_var('DIVQ', 1, vcnt, v4=divq3dsav ) + vcnt=vcnt+1 + call set_r_var('DIVQ', 1, vcnt, v4=divq3dsav ) - vcnt=vcnt+1 - call set_r_var('DIVT', 1, vcnt, v3=divt3dsav ) + vcnt=vcnt+1 + call set_r_var('DIVT', 1, vcnt, v3=divt3dsav ) - vcnt=vcnt+1 - call set_r_var('T2', 1, vcnt, v3=t2sav ) + vcnt=vcnt+1 + call set_r_var('T2', 1, vcnt, v3=t2sav ) - vcnt=vcnt+1 - call set_r_var('FU', 1, vcnt, v3=fusav ) + vcnt=vcnt+1 + call set_r_var('FU', 1, vcnt, v3=fusav ) - vcnt=vcnt+1 - call set_r_var('FV', 1, vcnt, v3=fvsav ) + vcnt=vcnt+1 + call set_r_var('FV', 1, vcnt, v3=fvsav ) - vcnt=vcnt+1 - call set_r_var('BETA', 1, vcnt, v1=betasav ) + vcnt=vcnt+1 + call set_r_var('BETA', 1, vcnt, v1=betasav ) -#endif + end if if(vcnt.ne.restartvarcnt) then write(iulog,*) 'vcnt= ',vcnt, ' restartvarcnt=',restartvarcnt @@ -231,11 +230,11 @@ subroutine init_restart_dynamics(File, dyn_out) qdims(1:2) = hdimids(1:2) qdims(3) = vdimids(1) qdims(5) = timelevels_dimid - + call init_restart_varlist() do i=1,restartvarcnt - + call get_restart_var(i, name, timelevels, ndims, vdesc) if(timelevels>1) then if(ndims==3) then @@ -356,15 +355,15 @@ subroutine write_restart_dynamics (File, dyn_out) else if(ndims==5) then call pio_write_darray(File, vdesc, iodesc4d, transfer(restartvars(i)%v5d(:,:,:,:,ct), mold), ierr) end if - + end do - + end if end do call pio_freedecomp(File, iodesc2d) call pio_freedecomp(File, iodesc3d) call pio_freedecomp(File, iodesc4d) - + return end subroutine write_restart_dynamics @@ -393,10 +392,8 @@ subroutine read_restart_dynamics (File, dyn_in, dyn_out) use pmgrid, only: plon, plat, beglat, endlat use ppgrid, only: pver - -#if ( defined BFB_CAM_SCAM_IOP ) + use iop, only: init_iop_fields -#endif use massfix, only: alpha, hw1, hw2, hw3 use prognostics, only: n3m2, n3m1, n3 @@ -467,9 +464,8 @@ subroutine read_restart_dynamics (File, dyn_in, dyn_out) call init_restart_varlist() -#if ( defined BFB_CAM_SCAM_IOP ) - call init_iop_fields() -#endif + if (write_camiop) call init_iop_fields() + do i=1,restartvarcnt call get_restart_var(i, name, timelevels, ndims, vdesc) @@ -533,13 +529,13 @@ function get_restart_decomp(hdim1, hdim2, nlev) result(ldof) endlatxy = get_dyn_grid_parm('endlatxy') plat = get_dyn_grid_parm('plat') - - + + lcnt=(endlatxy-beglatxy+1)*nlev*(endlonxy-beglonxy+1) allocate(ldof(lcnt)) lcnt=0 - ldof(:)=0 + ldof(:)=0 do j=beglatxy,endlatxy do k=1,nlev do i=beglonxy, endlonxy diff --git a/src/dynamics/eul/scmforecast.F90 b/src/dynamics/eul/scmforecast.F90 index f9c0cbc6a8..decdff9c7f 100644 --- a/src/dynamics/eul/scmforecast.F90 +++ b/src/dynamics/eul/scmforecast.F90 @@ -1,11 +1,11 @@ module scmforecast - ! --------------------------------------------------------------------------- ! + ! --------------------------------------------------------------------------- ! ! ! ! Compute Time-Marched 'T, u, v, q' for SCAM by summing the 'physics', ! - ! 'horizontal advection', and 'vertical advection' tendencies. ! - ! This module is used only for SCAM. ! - ! ! - ! --------------------------------------------------------------------------- ! + ! 'horizontal advection', and 'vertical advection' tendencies. ! + ! This module is used only for SCAM. ! + ! ! + ! --------------------------------------------------------------------------- ! use spmd_utils, only: masterproc use cam_logfile, only: iulog use cam_control_mod, only: adiabatic @@ -19,26 +19,26 @@ module scmforecast ! Private module data ! -!======================================================================= +!======================================================================= contains -!======================================================================= +!======================================================================= - subroutine forecast( lat , nlon , ztodt , & + subroutine forecast( lat , nlon , ztodt , & psm1 , psm2 , ps , & u3 , u3m1 , u3m2 , & v3 , v3m1 , v3m2 , & t3 , t3m1 , t3m2 , & - q3 , q3m1 , q3m2 , & + q3 , q3m1 , q3m2 , & tten_phys , uten_phys , vten_phys , & qminus , qfcst ) - ! --------------------------------------------------------------------------- ! + ! --------------------------------------------------------------------------- ! ! ! ! Compute Time-Marched 'T, u, v, q' for SCAM by summing the 'physics', ! - ! 'horizontal advection', and 'vertical advection' tendencies. ! - ! This module is used only for SCAM. ! - ! ! + ! 'horizontal advection', and 'vertical advection' tendencies. ! + ! This module is used only for SCAM. ! + ! ! ! Author : Sungsu Park. 2010. Sep. ! ! ! ! --------------------------------------------------------------------------- ! @@ -79,8 +79,8 @@ subroutine forecast( lat , nlon , ztodt , & ! x3 : final state variable after time-marching ! ! --------------------------------------------------- ! - integer, intent(in) :: lat - integer, intent(in) :: nlon + integer, intent(in) :: lat + integer, intent(in) :: nlon real(r8), intent(in) :: ztodt ! Twice time step unless nstep = 0 [ s ] real(r8), intent(in) :: ps(plon) ! Surface pressure [ Pa ] @@ -100,13 +100,15 @@ subroutine forecast( lat , nlon , ztodt , & real(r8), intent(inout) :: uten_phys(plev) ! Tendency of u by the sum of 'physics + geostrophic forcing' [ m/s/s ] real(r8), intent(inout) :: vten_phys(plev) ! Tendency of v by the sum of 'physics + geostrophic forcing' [ m/s/s ] real(r8) qten_phys(plev,pcnst) ! Tendency of q by the 'physics' [ #/kg/s, kg/kg/s ] - real(r8), intent(in) :: qminus(plon,plev,pcnst) ! ( qminus - q3m2 ) / ztodt = Tendency of tracers by the 'physics' [ #/kg/s, kg/kg/s ] + real(r8), intent(in) :: qminus(plon,plev,pcnst) ! (qminus - q3m2) / ztodt = + ! Tendency of tracers by the 'physics' [ #/kg/s, kg/kg/s ] real(r8), intent(out) :: t3(plev) ! Temperature [ K ] real(r8), intent(out) :: u3(plev) ! Zonal wind [ m/s ] real(r8), intent(out) :: v3(plev) ! Meridional wind [ m/s ] real(r8), intent(inout) :: q3(plev,pcnst) ! Tracers [ #/kg, kg/kg ] - real(r8), intent(inout) :: qfcst(plon,plev,pcnst) ! ( Input qfcst - q3m2 ) / ztodt = Tendency of q by the sum of 'physics' + 'SLT vertical advection' [ #/kg/s, kg/kg/s ] + real(r8), intent(inout) :: qfcst(plon,plev,pcnst) ! ( Input qfcst - q3m2 ) / ztodt = Tendency of q by the sum of 'physics' + + ! 'SLT vertical advection' [ #/kg/s, kg/kg/s ] ! --------------- ! @@ -115,25 +117,28 @@ subroutine forecast( lat , nlon , ztodt , & integer dummy integer dummy_dyndecomp - integer i, k, m - integer ixcldliq, ixcldice, ixnumliq, ixnumice + integer i, k, m + integer ixcldliq, ixcldice, ixnumliq, ixnumice, ioptop real(r8) weight, fac - real(r8) pmidm1(plev) - real(r8) pintm1(plevp) - real(r8) pdelm1(plev) - real(r8) wfldint(plevp) - real(r8) pdelb(plon,plev) - real(r8) tfcst(plev) ! ( tfcst - t3m2 ) / ztodt = Tendency of T by the sum of 'physics' + 'SLT/EUL/XXX vertical advection' [ K/s ] - real(r8) ufcst(plev) ! ( ufcst - u3m2 ) / ztodt = Tendency of u by the sum of 'physics' + 'SLT/EUL/XXX vertical advection' [ m/s/s ] - real(r8) vfcst(plev) ! ( vfcst - u3m2 ) / ztodt = Tendency of v by the sum of 'physics' + 'SLT/EUL/XXX vertical advection' [ m/s/s ] + real(r8) pmidm1(plev) + real(r8) pintm1(plevp) + real(r8) pdelm1(plev) + real(r8) wfldint(plevp) + real(r8) pdelb(plon,plev) + real(r8) tfcst(plev) ! ( tfcst - t3m2 ) / ztodt = Tendency of T by the sum of 'physics' + + ! 'SLT/EUL/XXX vertical advection' [ K/s ] + real(r8) ufcst(plev) ! ( ufcst - u3m2 ) / ztodt = Tendency of u by the sum of 'physics' + + ! 'SLT/EUL/XXX vertical advection' [ m/s/s ] + real(r8) vfcst(plev) ! ( vfcst - u3m2 ) / ztodt = Tendency of v by the sum of 'physics' + + ! 'SLT/EUL/XXX vertical advection' [ m/s/s ] logical scm_fincl_empty ! ----------------------------------------------- ! ! Centered Eulerian vertical advective tendencies ! ! ----------------------------------------------- ! real(r8) tten_zadv_EULc(plev) ! Vertical advective forcing of t [ K/s ] - real(r8) uten_zadv_EULc(plev) ! Vertical advective forcing of u [ m/s/s ] - real(r8) vten_zadv_EULc(plev) ! Vertical advective forcing of v [ m/s/s ] + real(r8) uten_zadv_EULc(plev) ! Vertical advective forcing of u [ m/s/s ] + real(r8) vten_zadv_EULc(plev) ! Vertical advective forcing of v [ m/s/s ] real(r8) qten_zadv_EULc(plev,pcnst) ! Vertical advective forcing of tracers [ #/kg/s, kg/kg/s ] ! --------------------------------- ! @@ -145,15 +150,15 @@ subroutine forecast( lat , nlon , ztodt , & ! Eulerian compression heating ! ! ---------------------------- ! - real(r8) tten_comp_EUL(plev) ! Compression heating by vertical advection [ K/s ] - + real(r8) tten_comp_EUL(plev) ! Compression heating by vertical advection [ K/s ] + ! ----------------------------------- ! ! Final vertical advective tendencies ! - ! ----------------------------------- ! + ! ----------------------------------- ! real(r8) tten_zadv(plev) ! Vertical advective forcing of t [ K/s ] - real(r8) uten_zadv(plev) ! Vertical advective forcing of u [ m/s/s ] - real(r8) vten_zadv(plev) ! Vertical advective forcing of v [ m/s/s ] + real(r8) uten_zadv(plev) ! Vertical advective forcing of u [ m/s/s ] + real(r8) vten_zadv(plev) ! Vertical advective forcing of v [ m/s/s ] real(r8) qten_zadv(plev,pcnst) ! Vertical advective forcing of tracers [ #/kg/s, kg/kg/s ] ! --------------------------- ! @@ -210,18 +215,19 @@ subroutine forecast( lat , nlon , ztodt , & 'use_obs_T ', scm_use_obs_T , & 'relaxation ', scm_relaxation , & 'use_3dfrc ', use_3dfrc - + !---BPM ! ---------------------------- ! - ! ! + ! ! ! Main Computation Begins Here ! ! ! ! ---------------------------- ! dummy = 2 dummy_dyndecomp = 1 + ioptop = minloc(tobs(:), 1, BACK=.true.)+1 ! ------------------------------------------------------------ ! @@ -239,19 +245,19 @@ subroutine forecast( lat , nlon , ztodt , & ! Note 'tten_phys, uten_phys, vten_phys' are already input. ! ! ------------------------------------------------------------ ! - qten_phys(:plev,:pcnst) = ( qminus(1,:plev,:pcnst) - q3m2(:plev,:pcnst) ) / ztodt + qten_phys(:plev,:pcnst) = ( qminus(1,:plev,:pcnst) - q3m2(:plev,:pcnst) ) / ztodt ! ----------------------------------------------------- ! ! Extract SLT-transported vertical advective tendencies ! ! TODO : Add in SLT transport of t u v as well ! ! ----------------------------------------------------- ! - qten_zadv_SLT(:plev,:pcnst) = ( qfcst(1,:plev,:pcnst) - qminus(1,:plev,:pcnst) ) / ztodt + qten_zadv_SLT(:plev,:pcnst) = ( qfcst(1,:plev,:pcnst) - qminus(1,:plev,:pcnst) ) / ztodt ! ------------------------------------------------------- ! - ! use_camiop = .true. : Use CAM-generated 3D IOP file ! - ! = .false. : Use User-generated SCAM IOP file ! - ! ------------------------------------------------------- ! + ! use_camiop = .true. : Use CAM-generated 3D IOP file ! + ! = .false. : Use User-generated SCAM IOP file ! + ! ------------------------------------------------------- ! if( use_camiop ) then @@ -260,7 +266,7 @@ subroutine forecast( lat , nlon , ztodt , & ufcst(k) = u3m2(k) + ztodt * uten_phys(k) + ztodt * divu3d(k) vfcst(k) = v3m2(k) + ztodt * vten_phys(k) + ztodt * divv3d(k) do m = 1, pcnst - ! Below two lines are identical but in order to reproduce the bit-by-bit results + ! Below two lines are identical but in order to reproduce the bit-by-bit results ! of CAM-3D simulation, I simply rewrite the 'original' into the 'expanded' one. ! Below is the 'original' one. ! qfcst(1,k,m) = q3m2(k,m) + ztodt * ( qten_phys(k,m) + divq3d(k,m) ) @@ -272,18 +278,18 @@ subroutine forecast( lat , nlon , ztodt , & else ! ---------------------------------------------------------------------------- ! - ! Compute 'omega'( wfldint ) at the interface from the value at the mid-point. ! + ! Compute 'omega'( wfldint ) at the interface from the value at the mid-point. ! ! SCAM-IOP file must provide omega at the mid-point not at the interface. ! ! ---------------------------------------------------------------------------- ! - + wfldint(1) = 0._r8 do k = 2, plev weight = ( pintm1(k) - pmidm1(k-1) ) / ( pmidm1(k) - pmidm1(k-1) ) wfldint(k) = ( 1._r8 - weight ) * wfld(k-1) + weight * wfld(k) enddo wfldint(plevp) = 0._r8 - - ! ------------------------------------------------------------ ! + + ! ------------------------------------------------------------ ! ! Compute Eulerian compression heating due to vertical motion. ! ! ------------------------------------------------------------ ! @@ -292,13 +298,13 @@ subroutine forecast( lat , nlon , ztodt , & enddo ! ---------------------------------------------------------------------------- ! - ! Compute Centered Eulerian vertical advective tendencies for all 't, u, v, q' ! - ! ---------------------------------------------------------------------------- ! + ! Compute Centered Eulerian vertical advective tendencies for all 't, u, v, q' ! + ! ---------------------------------------------------------------------------- ! do k = 2, plev - 1 fac = 1._r8 / ( 2.0_r8 * pdelm1(k) ) tten_zadv_EULc(k) = -fac * ( wfldint(k+1) * ( t3m1(k+1) - t3m1(k) ) + wfldint(k) * ( t3m1(k) - t3m1(k-1) ) ) - vten_zadv_EULc(k) = -fac * ( wfldint(k+1) * ( v3m1(k+1) - v3m1(k) ) + wfldint(k) * ( v3m1(k) - v3m1(k-1) ) ) + vten_zadv_EULc(k) = -fac * ( wfldint(k+1) * ( v3m1(k+1) - v3m1(k) ) + wfldint(k) * ( v3m1(k) - v3m1(k-1) ) ) uten_zadv_EULc(k) = -fac * ( wfldint(k+1) * ( u3m1(k+1) - u3m1(k) ) + wfldint(k) * ( u3m1(k) - u3m1(k-1) ) ) do m = 1, pcnst qten_zadv_EULc(k,m) = -fac * ( wfldint(k+1) * ( q3m1(k+1,m) - q3m1(k,m) ) + wfldint(k) * ( q3m1(k,m) - q3m1(k-1,m) ) ) @@ -324,7 +330,7 @@ subroutine forecast( lat , nlon , ztodt , & end do ! ------------------------------------- ! - ! Manupulate individual forcings before ! + ! Manupulate individual forcings before ! ! computing the final forecasted state ! ! ------------------------------------- ! @@ -379,20 +385,20 @@ subroutine forecast( lat , nlon , ztodt , & ! -------------------------------------------------------------- ! ! Check horizontal advection u,v,t,q ! ! -------------------------------------------------------------- ! - if (.not. have_divu) divu=0._r8 - if (.not. have_divv) divv=0._r8 - if (.not. have_divt) divt=0._r8 - if (.not. have_divq) divq=0._r8 + if (.not. have_divu) divu=0._r8 + if (.not. have_divv) divv=0._r8 + if (.not. have_divt) divt=0._r8 + if (.not. have_divq) divq=0._r8 ! ----------------------------------- ! - ! ! + ! ! ! Compute the final forecasted states ! ! ! - ! ----------------------------------- ! + ! ----------------------------------- ! ! make sure we have everything ! - ! ----------------------------------- ! + ! ----------------------------------- ! - if( .not. scm_use_obs_uv .and. .not. have_divu .and. .not. have_divv ) then + if( .not. scm_use_obs_uv .and. .not. have_divu .and. .not. have_divv ) then call endrun( subname//':: divu and divv not on the iop Unable to forecast Wind Set & scm_use_obs_uv=true to use observed u and v') end if @@ -408,7 +414,7 @@ subroutine forecast( lat , nlon , ztodt , & ufcst(k) = u3m2(k) + ztodt * ( uten_phys(k) + divu(k) + uten_zadv(k) ) vfcst(k) = v3m2(k) + ztodt * ( vten_phys(k) + divv(k) + vten_zadv(k) ) do m = 1, pcnst - qfcst(1,k,m) = q3m2(k,m) + ztodt * ( qten_phys(k,m) + divq(k,m) + qten_zadv(k,m) ) + qfcst(1,k,m) = q3m2(k,m) + ztodt * ( qten_phys(k,m) + divq(k,m) + qten_zadv(k,m) ) enddo enddo @@ -453,32 +459,35 @@ subroutine forecast( lat , nlon , ztodt , & ! at each time step if specified by the switch. ! ! If SCAM-IOP has 't,u,v,q' profile at a single initial time step. ! ! ---------------------------------------------------------------- ! - - if( scm_use_obs_T .and. have_t ) then + + if( scm_use_obs_T .and. have_t ) then do k = 1, plev tfcst(k) = tobs(k) enddo endif - - if( scm_use_obs_uv .and. have_u .and. have_v ) then - do k = 1, plev - ufcst(k) = uobs(k) - vfcst(k) = vobs(k) - enddo + + if( scm_use_obs_uv .and. have_u .and. have_v ) then + ufcst(:plev) = uobs(:plev) + vfcst(:plev) = vobs(:plev) endif - - if( scm_use_obs_qv .and. have_q ) then + + if( scm_use_obs_qv .and. have_q ) then do k = 1, plev qfcst(1,k,1) = qobs(k) enddo endif - + + !If not using camiop then fillt tobs/qobs with background CAM state above IOP top before t3/q3 update below + if( .not. use_camiop ) then + tobs(1:ioptop-1)=t3(1:ioptop-1) + qobs(1:ioptop-1)=q3(1:ioptop-1,1) + end if ! ------------------------------------------------------------------- ! ! Relaxation to the observed or specified state ! ! We should specify relaxation time scale ( rtau ) and ! ! target-relaxation state ( in the current case, either 'obs' or 0 ) ! ! ------------------------------------------------------------------- ! - + relax_T(:) = 0._r8 relax_u(:) = 0._r8 relax_v(:) = 0._r8 @@ -503,34 +512,34 @@ subroutine forecast( lat , nlon , ztodt , & do k = 1, plev if( scm_relaxation ) then - if ( pmidm1(k).le.scm_relax_bot_p.and.pmidm1(k).ge.scm_relax_top_p ) then ! inside layer + if ( pmidm1(k)<=scm_relax_bot_p.and.pmidm1(k) >= scm_relax_top_p ) then ! inside layer if (scm_relax_linear) then rtau(k) = rslope*pmidm1(k) + rycept ! linear regime else rtau(k) = max( ztodt, scm_relax_tau_sec ) ! constant for whole layer / no relax outside endif - else if (scm_relax_linear .and. pmidm1(k).le.scm_relax_top_p ) then ! not linear => do nothing / linear => use upper value + else if (scm_relax_linear .and. pmidm1(k)<=scm_relax_top_p ) then ! not linear => do nothing / linear => use upper value rtau(k) = scm_relax_tau_top_sec ! above layer keep rtau equal to the top endif ! +BPM: this can't be the best way... ! I put this in because if rtau doesn't get set above, then I don't want to do any relaxation in that layer. - ! maybe the logic of this whole loop needs to be re-thinked. - if (rtau(k).ne.0) then + ! maybe the logic of this whole loop needs to be re-thinked. + if (rtau(k) /= 0) then relax_T(k) = - ( tfcst(k) - tobs(k) ) / rtau(k) relax_u(k) = - ( ufcst(k) - uobs(k) ) / rtau(k) - relax_v(k) = - ( vfcst(k) - vobs(k) ) / rtau(k) + relax_v(k) = - ( vfcst(k) - vobs(k) ) / rtau(k) relax_q(k,1) = - ( qfcst(1,k,1) - qobs(k) ) / rtau(k) do m = 2, pcnst relax_q(k,m) = - ( qfcst(1,k,m) - qinitobs(k,m) ) / rtau(k) enddo - if (scm_fincl_empty .or. ANY(scm_relax_fincl(:).eq.'T')) & + if (scm_fincl_empty .or. ANY(scm_relax_fincl(:)=='T')) & tfcst(k) = tfcst(k) + relax_T(k) * ztodt - if (scm_fincl_empty .or.ANY(scm_relax_fincl(:).eq.'U')) & + if (scm_fincl_empty .or.ANY(scm_relax_fincl(:)=='U')) & ufcst(k) = ufcst(k) + relax_u(k) * ztodt - if (scm_fincl_empty .or. ANY(scm_relax_fincl(:).eq.'V')) & + if (scm_fincl_empty .or. ANY(scm_relax_fincl(:)=='V')) & vfcst(k) = vfcst(k) + relax_v(k) * ztodt do m = 1, pcnst - if (scm_fincl_empty .or. ANY(scm_relax_fincl(:) .eq. trim(to_upper(cnst_name(m)))) ) then + if (scm_fincl_empty .or. ANY(scm_relax_fincl(:) == trim(to_upper(cnst_name(m)))) ) then qfcst(1,k,m) = qfcst(1,k,m) + relax_q(k,m) * ztodt end if enddo @@ -540,22 +549,22 @@ subroutine forecast( lat , nlon , ztodt , & call outfld( 'TRELAX' , relax_T , plon, dummy ) call outfld( 'QRELAX' , relax_q(1:plev,1) , plon, dummy ) call outfld( 'TAURELAX' , rtau , plon, dummy ) - + ! --------------------------------------------------------- ! ! Assign the final forecasted state to the output variables ! ! --------------------------------------------------------- ! - + t3(1:plev) = tfcst(1:plev) u3(1:plev) = ufcst(1:plev) v3(1:plev) = vfcst(1:plev) q3(1:plev,1:pcnst) = qfcst(1,1:plev,1:pcnst) - + tdiff(1:plev) = t3(1:plev) - tobs(1:plev) qdiff(1:plev) = q3(1:plev,1) - qobs(1:plev) call outfld( 'QDIFF' , qdiff, plon, dummy_dyndecomp ) call outfld( 'TDIFF' , tdiff, plon, dummy_dyndecomp ) - + return end subroutine forecast diff --git a/src/dynamics/eul/stepon.F90 b/src/dynamics/eul/stepon.F90 index 61c3eea1ce..4c86f1d27e 100644 --- a/src/dynamics/eul/stepon.F90 +++ b/src/dynamics/eul/stepon.F90 @@ -16,8 +16,7 @@ module stepon use ppgrid, only: begchunk, endchunk use physics_types, only: physics_state, physics_tend use time_manager, only: is_first_step, get_step_size - use iop, only: setiopupdate, readiopdata - use scamMod, only: use_iop,doiopupdate,use_pert_frc,wfld,wfldh,single_column + use scamMod, only: use_iop,doiopupdate,use_pert_frc,wfld,wfldh,single_column,setiopupdate, readiopdata use perf_mod use aerosol_properties_mod, only: aerosol_properties @@ -75,12 +74,11 @@ subroutine stepon_init(dyn_in, dyn_out) use dyn_comp, only: dyn_import_t, dyn_export_t use scanslt, only: scanslt_initial use commap, only: clat + use cam_history, only: write_camiop use constituents, only: pcnst use physconst, only: gravit use eul_control_mod,only: eul_nsplit -#if ( defined BFB_CAM_SCAM_IOP ) use iop, only:init_iop_fields -#endif !----------------------------------------------------------------------- ! Arguments ! @@ -151,11 +149,9 @@ subroutine stepon_init(dyn_in, dyn_out) call t_stopf ('stepon_startup') -#if ( defined BFB_CAM_SCAM_IOP ) - if (is_first_step()) then + if (is_first_step() .and. write_camiop) then call init_iop_fields() endif -#endif ! get aerosol properties aero_props_obj => aerosol_properties_object() @@ -294,6 +290,10 @@ subroutine stepon_run3( ztodt, cam_out, phys_state, dyn_in, dyn_out ) !----------------------------------------------------------------------- use dyn_comp, only: dyn_import_t, dyn_export_t use eul_control_mod,only: eul_nsplit + use prognostics, only: ps + use iop, only: iop_update_prognostics + use hycoef, only: hyam, hybm, hyai, hybi, ps0 + real(r8), intent(in) :: ztodt ! twice time step unless nstep=0 type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) type(physics_state), intent(in):: phys_state(begchunk:endchunk) @@ -309,10 +309,12 @@ subroutine stepon_run3( ztodt, cam_out, phys_state, dyn_in, dyn_out ) call setiopupdate end if - ! Update IOP properties e.g. omega, divT, divQ - - if (doiopupdate) call readiopdata() + ! Read IOP data and update prognostics if needed + if (doiopupdate) then + call readiopdata(hyam, hybm, hyai, hybi, ps0) + call iop_update_prognostics(n3,ps=ps) + end if endif !---------------------------------------------------------- diff --git a/src/dynamics/eul/tfilt_massfix.F90 b/src/dynamics/eul/tfilt_massfix.F90 index a603c38fc9..0a43280a09 100644 --- a/src/dynamics/eul/tfilt_massfix.F90 +++ b/src/dynamics/eul/tfilt_massfix.F90 @@ -38,7 +38,7 @@ subroutine tfilt_massfixrun (ztodt, lat, u3m1, u3, & !----------------------------------------------------------------------- use shr_kind_mod, only: r8 => shr_kind_r8 use cam_control_mod, only: ideal_phys, tj2016_phys - use cam_history, only: outfld + use cam_history, only: outfld, write_camiop use eul_control_mod, only: fixmas,eps use pmgrid, only: plon, plev, plevp, plat use commap, only: clat @@ -51,10 +51,9 @@ subroutine tfilt_massfixrun (ztodt, lat, u3m1, u3, & use phys_control, only: phys_getopts use qneg_module, only: qneg3 -#if ( defined BFB_CAM_SCAM_IOP ) use iop use constituents, only: cnst_get_ind, cnst_name -#endif + implicit none ! @@ -139,12 +138,10 @@ subroutine tfilt_massfixrun (ztodt, lat, u3m1, u3, & ! real(r8) engk ! Kinetic energy integral ! real(r8) engp ! Potential energy integral integer i, k, m,j,ixcldliq,ixcldice,ixnumliq,ixnumice -#if ( defined BFB_CAM_SCAM_IOP ) real(r8) :: u3forecast(plon,plev) real(r8) :: v3forecast(plon,plev) real(r8) :: t3forecast(plon,plev),delta_t3(plon,plev) real(r8) :: q3forecast(plon,plev,pcnst),delta_q3(plon,plev,pcnst) -#endif real(r8) fixmas_plon(plon) real(r8) beta_plon(plon) real(r8) clat_plon(plon) @@ -152,64 +149,63 @@ subroutine tfilt_massfixrun (ztodt, lat, u3m1, u3, & !----------------------------------------------------------------------- nstep = get_nstep() -#if ( defined BFB_CAM_SCAM_IOP ) -! -! Calculate 3d dynamics term -! - do k=1,plev - do i=1,nlon - divt3dsav(i,k,lat)=(t3(i,k)-tm2(i,k))/ztodt -t2sav(i,k,lat) - divu3dsav(i,k,lat)=(u3(i,k)-um2(i,k))/ztodt -fusav(i,k,lat) - divv3dsav(i,k,lat)=(v3(i,k)-vm2(i,k))/ztodt -fvsav(i,k,lat) - t3forecast(i,k)=tm2(i,k)+ztodt*t2sav(i,k,lat)+ztodt*divt3dsav(i,k,lat) - u3forecast(i,k)=um2(i,k)+ztodt*fusav(i,k,lat)+ztodt*divu3dsav(i,k,lat) - v3forecast(i,k)=vm2(i,k)+ztodt*fvsav(i,k,lat)+ztodt*divv3dsav(i,k,lat) + if (write_camiop) then + ! + ! Calculate 3d dynamics term + ! + do k=1,plev + do i=1,nlon + divt3dsav(i,k,lat)=(t3(i,k)-tm2(i,k))/ztodt -t2sav(i,k,lat) + divu3dsav(i,k,lat)=(u3(i,k)-um2(i,k))/ztodt -fusav(i,k,lat) + divv3dsav(i,k,lat)=(v3(i,k)-vm2(i,k))/ztodt -fvsav(i,k,lat) + t3forecast(i,k)=tm2(i,k)+ztodt*t2sav(i,k,lat)+ztodt*divt3dsav(i,k,lat) + u3forecast(i,k)=um2(i,k)+ztodt*fusav(i,k,lat)+ztodt*divu3dsav(i,k,lat) + v3forecast(i,k)=vm2(i,k)+ztodt*fvsav(i,k,lat)+ztodt*divv3dsav(i,k,lat) + end do end do - end do - do i=1,nlon - do m=1,pcnst - do k=1,plev - divq3dsav(i,k,m,lat)= (qfcst(i,k,m)-qminus(i,k,m))/ztodt - q3forecast(i,k,m)=qminus(i,k,m)+divq3dsav(i,k,m,lat)*ztodt + do i=1,nlon + do m=1,pcnst + do k=1,plev + divq3dsav(i,k,m,lat)= (qfcst(i,k,m)-qminus(i,k,m))/ztodt + q3forecast(i,k,m)=qminus(i,k,m)+divq3dsav(i,k,m,lat)*ztodt + end do end do end do - end do - q3(:nlon,:,:)=q3forecast(:nlon,:,:) - t3(:nlon,:)=t3forecast(:nlon,:) - qfcst(:nlon,:,:)=q3(:nlon,:,:) - -! -! outflds for iop history tape - to get bit for bit with scam -! the n-1 values are put out. After the fields are written out -! the current time level of info will be buffered for output next -! timestep -! - call outfld('t',t3 ,plon ,lat ) - call outfld('q',q3 ,plon ,lat ) - call outfld('Ps',ps ,plon ,lat ) - call outfld('u',u3 ,plon ,lat ) - call outfld('v',v3 ,plon ,lat ) -! -! read single values into plon arrays for output to history tape -! it would be nice if history tape supported 1 dimensional array variables -! - fixmas_plon(:)=fixmas - beta_plon(:)=beta - clat_plon(:)=clat(lat) - - call outfld('fixmas',fixmas_plon,plon ,lat ) - call outfld('beta',beta_plon ,plon ,lat ) - call outfld('CLAT ',clat_plon ,plon ,lat ) - call outfld('divT3d',divt3dsav(1,1,lat) ,plon ,lat ) - call outfld('divU3d',divu3dsav(1,1,lat) ,plon ,lat ) - call outfld('divV3d',divv3dsav(1,1,lat) ,plon ,lat ) - do m =1,pcnst - call outfld(trim(cnst_name(m))//'_dten',divq3dsav(1,1,m,lat) ,plon ,lat ) - end do -#endif - + q3(:nlon,:,:)=q3forecast(:nlon,:,:) + t3(:nlon,:)=t3forecast(:nlon,:) + qfcst(:nlon,:,:)=q3(:nlon,:,:) + + ! + ! outflds for iop history tape - to get bit for bit with scam + ! the n-1 values are put out. After the fields are written out + ! the current time level of info will be buffered for output next + ! timestep + ! + call outfld('t',t3 ,plon ,lat ) + call outfld('q',q3 ,plon ,lat ) + call outfld('Ps',ps ,plon ,lat ) + call outfld('u',u3 ,plon ,lat ) + call outfld('v',v3 ,plon ,lat ) + ! + ! read single values into plon arrays for output to history tape + ! it would be nice if history tape supported 1 dimensional array variables + ! + fixmas_plon(:)=fixmas + beta_plon(:)=beta + clat_plon(:)=clat(lat) + + call outfld('fixmas',fixmas_plon,plon ,lat ) + call outfld('beta',beta_plon ,plon ,lat ) + call outfld('CLAT ',clat_plon ,plon ,lat ) + call outfld('divT3d',divt3dsav(1,1,lat) ,plon ,lat ) + call outfld('divU3d',divu3dsav(1,1,lat) ,plon ,lat ) + call outfld('divV3d',divv3dsav(1,1,lat) ,plon ,lat ) + do m =1,pcnst + call outfld(trim(cnst_name(m))//'_dten',divq3dsav(1,1,m,lat) ,plon ,lat ) + end do + end if coslat = cos(clat(lat)) do i=1,nlon @@ -291,9 +287,9 @@ subroutine tfilt_massfixrun (ztodt, lat, u3m1, u3, & dqfx3(i,k,m) = dqfxcam(i,k,m) else dqfx3(i,k,m) = alpha(m)*etamid(k)*abs(qfcst(i,k,m) - qminus(i,k,m)) -#if ( defined BFB_CAM_SCAM_IOP ) - dqfx3sav(i,k,m,lat) = dqfx3(i,k,m) -#endif + if (write_camiop) then + dqfx3sav(i,k,m,lat) = dqfx3(i,k,m) + endif endif end do if (lfixlim) then @@ -333,14 +329,13 @@ subroutine tfilt_massfixrun (ztodt, lat, u3m1, u3, & end do ! i end do ! k - -#if ( defined BFB_CAM_SCAM_IOP ) - do m=1,pcnst - alpha_plon(:)= alpha(m) - call outfld(trim(cnst_name(m))//'_alph',alpha_plon ,plon ,lat ) - call outfld(trim(cnst_name(m))//'_dqfx',dqfx3sav(1,1,m,lat) ,plon ,lat ) - end do -#endif + if (write_camiop) then + do m=1,pcnst + alpha_plon(:)= alpha(m) + call outfld(trim(cnst_name(m))//'_alph',alpha_plon ,plon ,lat ) + call outfld(trim(cnst_name(m))//'_dqfx',dqfx3sav(1,1,m,lat) ,plon ,lat ) + end do + end if ! ! Check for and correct invalid constituents ! diff --git a/src/dynamics/fv/cd_core.F90 b/src/dynamics/fv/cd_core.F90 index f7f64e6512..ad5e35aab8 100644 --- a/src/dynamics/fv/cd_core.F90 +++ b/src/dynamics/fv/cd_core.F90 @@ -251,7 +251,6 @@ subroutine cd_core(grid, nx, u, v, pt, & ! with coefficient del2coef (default 3E5) ! ! - ldiv2: 2nd-order divergence damping everywhere and increasing in top layers - ! (default cam3.5 setting) ! ! - ldiv4: 4th-order divergence damping everywhere and increasing in top layers ! @@ -530,7 +529,6 @@ subroutine cd_core(grid, nx, u, v, pt, & if (div24del2flag == 2) then - ! cam3.5 default damping setting ldiv2 = .true. ldiv4 = .false. ldel2 = .false. @@ -608,7 +606,7 @@ subroutine cd_core(grid, nx, u, v, pt, & !*********************************************** ! - ! cam3 default second-order divergence damping + ! second-order divergence damping ! !*********************************************** press = D0_5 * ( grid%ak(k)+grid%ak(k+1) + & 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/fv/dynamics_vars.F90 b/src/dynamics/fv/dynamics_vars.F90 index 97cbfb7d34..73f8c1e26b 100644 --- a/src/dynamics/fv/dynamics_vars.F90 +++ b/src/dynamics/fv/dynamics_vars.F90 @@ -927,7 +927,6 @@ subroutine grid_vars_init(pi, ae, om, dt, fft_flt, & grid%cosp, grid%cose, ycrit) !for filtering of u and v in div4 damping - !(needs larger halo than cam3.5 code) call pft_cf(im, jm, js2gs, jn2gd, jn1gs, & grid%scdiv4, grid%sediv4, grid%dcdiv4, grid%dediv4, & grid%cosp, grid%cose, ycrit) 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/driver/cam_mpas_subdriver.F90 b/src/dynamics/mpas/driver/cam_mpas_subdriver.F90 index cc6ac75114..ede3df723d 100644 --- a/src/dynamics/mpas/driver/cam_mpas_subdriver.F90 +++ b/src/dynamics/mpas/driver/cam_mpas_subdriver.F90 @@ -2222,7 +2222,7 @@ subroutine cam_mpas_run(integrationLength) type (MPAS_Time_Type) :: currTime type (MPAS_Time_type) :: runUntilTime character(len=StrKIND) :: timeStamp - type (mpas_pool_type), pointer :: state, diag, mesh + type (mpas_pool_type), pointer :: state, diag, mesh, tend_physics integer, pointer :: index_qv integer, pointer :: nCellsSolve @@ -2238,6 +2238,11 @@ subroutine cam_mpas_run(integrationLength) call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'state', state) call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'diag', diag) call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'mesh', mesh) + call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'tend_physics', tend_physics) + +#ifdef MPAS_OPENACC + call cam_mpas_gpudata_host_to_device(state, diag, tend_physics) +#endif !MPAS_OPENACC ! During integration, time level 1 stores the model state at the beginning of the ! time step, and time level 2 stores the state advanced dt in time by timestep(...) @@ -2263,6 +2268,10 @@ subroutine cam_mpas_run(integrationLength) currTime = mpas_get_clock_time(clock, MPAS_NOW, ierr) end do +#ifdef MPAS_OPENACC + call cam_mpas_gpudata_device_to_host(state, diag, tend_physics) +#endif !MPAS_OPENACC + ! ! Compute diagnostic fields from the final prognostic state ! @@ -2281,6 +2290,98 @@ subroutine cam_mpas_run(integrationLength) end subroutine cam_mpas_run + !----------------------------------------------------------------------- + ! routine cam_mpas_gpudata_host_to_device + ! + !> \brief Transfer data from CPU to GPU before atm_do_timestep + !> \author G. Dylan Dickerson + !> \date 15 October 2024 + !> \details + !> SOME DETAIL HERE + ! + !----------------------------------------------------------------------- + subroutine cam_mpas_gpudata_host_to_device(state, diag, tend_physics) + + use mpas_derived_types, only : mpas_pool_type + use mpas_kind_types, only : RKIND + use mpas_pool_routines, only : mpas_pool_get_array_gpu + + type (mpas_pool_type), pointer :: state, diag, tend_physics + real(kind=RKIND), dimension(:,:), pointer :: u, w, theta_m, rho_zz + real(kind=RKIND), dimension(:,:,:), pointer :: scalars + real(kind=RKIND), dimension(:,:), pointer :: theta, exner, rho, uReconstructZonal, uReconstructMeridional + real(kind=RKIND), dimension(:,:), pointer :: tend_ru_physics, tend_rho_physics, tend_rtheta_physics + + ! state pool arrays, modify the "current" state in timeLevel=1 + call mpas_pool_get_array_gpu(state, 'u', u, timeLevel=1) + call mpas_pool_get_array_gpu(state, 'w', w, timeLevel=1) + call mpas_pool_get_array_gpu(state, 'theta_m', theta_m, timeLevel=1) + call mpas_pool_get_array_gpu(state, 'rho_zz', rho_zz, timeLevel=1) + call mpas_pool_get_array_gpu(state, 'scalars', scalars, timeLevel=1) + !$acc update device(u,w,theta_m,rho_zz,scalars) + + ! diag pool arrays + call mpas_pool_get_array_gpu(diag, 'theta', theta) + call mpas_pool_get_array_gpu(diag, 'exner', exner) + call mpas_pool_get_array_gpu(diag, 'rho', rho) + call mpas_pool_get_array_gpu(diag, 'uReconstructZonal', uReconstructZonal) + call mpas_pool_get_array_gpu(diag, 'uReconstructMeridional', uReconstructMeridional) + !$acc update device(theta,exner,rho,uReconstructZonal,uReconstructMeridional) + + ! tend pool arrays + call mpas_pool_get_array_gpu(tend_physics, 'tend_ru_physics', tend_ru_physics) + call mpas_pool_get_array_gpu(tend_physics, 'tend_rtheta_physics', tend_rtheta_physics) + call mpas_pool_get_array_gpu(tend_physics, 'tend_rho_physics', tend_rho_physics) + !$acc update device(tend_ru_physics,tend_rtheta_physics,tend_rho_physics) + + end subroutine cam_mpas_gpudata_host_to_device + + + !----------------------------------------------------------------------- + ! routine cam_mpas_gpudata_device_to_host + ! + !> \brief Transfer data from GPU to CPU after atm_do_timestep + !> \author G. Dylan Dickerson + !> \date 15 October 2024 + !> \details + !> SOME DETAIL HERE + ! + !----------------------------------------------------------------------- + subroutine cam_mpas_gpudata_device_to_host(state, diag, tend_physics) + + use mpas_derived_types, only : mpas_pool_type + use mpas_kind_types, only : RKIND + use mpas_pool_routines, only : mpas_pool_get_array_gpu + + type (mpas_pool_type), pointer :: state, diag, tend_physics + real(kind=RKIND), dimension(:,:), pointer :: u, w, theta_m, rho_zz + real(kind=RKIND), dimension(:,:,:), pointer :: scalars + real(kind=RKIND), dimension(:,:), pointer :: theta, exner, rho, uReconstructZonal, uReconstructMeridional, & + v, vorticity, divergence + + ! state pool arrays, modify the "current" state in timeLevel=1 + call mpas_pool_get_array_gpu(state, 'u', u, timeLevel=1) + call mpas_pool_get_array_gpu(state, 'w', w, timeLevel=1) + call mpas_pool_get_array_gpu(state, 'theta_m', theta_m, timeLevel=1) + call mpas_pool_get_array_gpu(state, 'rho_zz', rho_zz, timeLevel=1) + call mpas_pool_get_array_gpu(state, 'scalars', scalars, timeLevel=1) + !$acc update host(u,w,theta_m,rho_zz,scalars) + + ! diag pool arrays + call mpas_pool_get_array_gpu(diag, 'theta', theta) + call mpas_pool_get_array_gpu(diag, 'exner', exner) + call mpas_pool_get_array_gpu(diag, 'rho', rho) + call mpas_pool_get_array_gpu(diag, 'uReconstructZonal', uReconstructZonal) + call mpas_pool_get_array_gpu(diag, 'uReconstructMeridional', uReconstructMeridional) + call mpas_pool_get_array_gpu(diag, 'v', v) + call mpas_pool_get_array_gpu(diag, 'vorticity', vorticity) + call mpas_pool_get_array_gpu(diag, 'divergence', divergence) + !$acc update host(theta,exner,rho,uReconstructZonal,uReconstructMeridional, & + !$acc v,vorticity,divergence) + + end subroutine cam_mpas_gpudata_device_to_host + + !----------------------------------------------------------------------- ! routine cam_mpas_finalize ! diff --git a/src/dynamics/mpas/dycore b/src/dynamics/mpas/dycore new file mode 160000 index 0000000000..2f4c5980d4 --- /dev/null +++ b/src/dynamics/mpas/dycore @@ -0,0 +1 @@ +Subproject commit 2f4c5980d41d86ef19ce108755015181024ac914 diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index 300a38446d..a07d7407f4 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -1364,6 +1364,7 @@ subroutine cam_mpas_namelist_read(namelistFilename, configPool) real(r8) :: mpas_zd = 22000.0_r8 real(r8) :: mpas_xnutr = 0.2_r8 real(r8) :: mpas_cam_coef = 0.0_r8 + integer :: mpas_cam_damping_levels = 0 logical :: mpas_rayleigh_damp_u = .true. real(r8) :: mpas_rayleigh_damp_u_timescale_days = 5.0_r8 integer :: mpas_number_rayleigh_damp_u_levels = 3 @@ -1414,6 +1415,7 @@ subroutine cam_mpas_namelist_read(namelistFilename, configPool) mpas_zd, & mpas_xnutr, & mpas_cam_coef, & + mpas_cam_damping_levels, & mpas_rayleigh_damp_u, & mpas_rayleigh_damp_u_timescale_days, & mpas_number_rayleigh_damp_u_levels @@ -1549,6 +1551,7 @@ subroutine cam_mpas_namelist_read(namelistFilename, configPool) call mpi_bcast(mpas_zd, 1, mpi_real8, masterprocid, mpicom, mpi_ierr) call mpi_bcast(mpas_xnutr, 1, mpi_real8, masterprocid, mpicom, mpi_ierr) call mpi_bcast(mpas_cam_coef, 1, mpi_real8, masterprocid, mpicom, mpi_ierr) + call mpi_bcast(mpas_cam_damping_levels, 1, mpi_integer, masterprocid, mpicom, mpi_ierr) call mpi_bcast(mpas_rayleigh_damp_u, 1, mpi_logical, masterprocid, mpicom, mpi_ierr) call mpi_bcast(mpas_rayleigh_damp_u_timescale_days, 1, mpi_real8, masterprocid, mpicom, mpi_ierr) call mpi_bcast(mpas_number_rayleigh_damp_u_levels, 1, mpi_integer, masterprocid, mpicom, mpi_ierr) @@ -1556,6 +1559,7 @@ subroutine cam_mpas_namelist_read(namelistFilename, configPool) call mpas_pool_add_config(configPool, 'config_zd', mpas_zd) call mpas_pool_add_config(configPool, 'config_xnutr', mpas_xnutr) call mpas_pool_add_config(configPool, 'config_mpas_cam_coef', mpas_cam_coef) + call mpas_pool_add_config(configPool, 'config_number_cam_damping_levels', mpas_cam_damping_levels) call mpas_pool_add_config(configPool, 'config_rayleigh_damp_u', mpas_rayleigh_damp_u) call mpas_pool_add_config(configPool, 'config_rayleigh_damp_u_timescale_days', mpas_rayleigh_damp_u_timescale_days) call mpas_pool_add_config(configPool, 'config_number_rayleigh_damp_u_levels', mpas_number_rayleigh_damp_u_levels) @@ -1706,6 +1710,7 @@ subroutine cam_mpas_namelist_read(namelistFilename, configPool) write(iulog,*) ' mpas_zd = ', mpas_zd write(iulog,*) ' mpas_xnutr = ', mpas_xnutr write(iulog,*) ' mpas_cam_coef = ', mpas_cam_coef + write(iulog,*) ' mpas_cam_damping_levels = ', mpas_cam_damping_levels write(iulog,*) ' mpas_rayleigh_damp_u = ', mpas_rayleigh_damp_u write(iulog,*) ' mpas_rayleigh_damp_u_timescale_days = ', mpas_rayleigh_damp_u_timescale_days write(iulog,*) ' mpas_number_rayleigh_damp_u_levels = ', mpas_number_rayleigh_damp_u_levels diff --git a/src/dynamics/mpas/dyn_grid.F90 b/src/dynamics/mpas/dyn_grid.F90 index d0b53c5fa0..7efcc866dd 100644 --- a/src/dynamics/mpas/dyn_grid.F90 +++ b/src/dynamics/mpas/dyn_grid.F90 @@ -453,6 +453,8 @@ subroutine setup_time_invariant(fh_ini) type(mpas_pool_type), pointer :: meshPool real(r8), pointer :: rdzw(:) real(r8), allocatable :: dzw(:) + integer, pointer :: nCells + real(r8), dimension(:), pointer :: lonCell integer :: k, kk integer :: ierr @@ -473,6 +475,7 @@ subroutine setup_time_invariant(fh_ini) call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve) call mpas_pool_get_dimension(meshPool, 'nVerticesSolve', nVerticesSolve) call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevelsSolve) ! MPAS always solves over the full column + call mpas_pool_get_dimension(meshPool, 'nCells', nCells) ! check that number of vertical layers matches MPAS grid data if (plev /= nVertLevelsSolve) then @@ -482,6 +485,17 @@ subroutine setup_time_invariant(fh_ini) ') does not match plev ('//int2str(nVertLevelsSolve)//').') end if + ! Ensure longitudes are within the [0,2*pi) range, and only remap values that + ! are outside the range. Some non-simple physics in CAM require this + ! longitude range, the MPAS-A dycore does not require any specific range for + ! lonCell + call mpas_pool_get_array(meshPool, 'lonCell', lonCell) + do k=1,nCells + if (lonCell(k) < 0._r8 .or. lonCell(k) >= (2._r8 * pi)) then + lonCell(k) = lonCell(k) - (2._r8 * pi) * floor(lonCell(k) / (2._r8 * pi)) + end if + end do + ! Initialize fields needed for reconstruction of cell-centered winds from edge-normal winds ! Note: This same pair of calls happens a second time later in the initialization of ! the MPAS-A dycore (in atm_mpas_init_block), but the redundant calls do no harm diff --git a/src/dynamics/se/advect_tend.F90 b/src/dynamics/se/advect_tend.F90 index 44ea0ff6f7..3512b57507 100644 --- a/src/dynamics/se/advect_tend.F90 +++ b/src/dynamics/se/advect_tend.F90 @@ -10,8 +10,14 @@ module advect_tend private public :: compute_adv_tends_xyz + public :: compute_write_iop_fields real(r8), allocatable :: adv_tendxyz(:,:,:,:,:) + real(r8), allocatable :: iop_qtendxyz(:,:,:,:,:) + real(r8), allocatable :: iop_qtendxyz_init(:,:,:,:,:) + real(r8), allocatable :: derivedfq(:,:,:,:,:) + real(r8), allocatable :: iop_ttendxyz(:,:,:,:) + real(r8), allocatable :: iop_ttendxyz_init(:,:,:,:) contains @@ -22,18 +28,18 @@ module advect_tend ! - second call computes and outputs the tendencies !---------------------------------------------------------------------- subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0) - use cam_history, only: outfld, hist_fld_active + use cam_history, only: outfld use time_manager, only: get_step_size - use constituents, only: tottnam,pcnst + use constituents, only: tottnam,pcnst use dimensions_mod, only: nc,np,nlev,use_cslam use element_mod, only: element_t - use fvm_control_volume_mod, only: fvm_struct + use fvm_control_volume_mod, only: fvm_struct implicit none type (element_t), intent(in) :: elem(:) type(fvm_struct), intent(in) :: fvm(:) integer, intent(in) :: nets,nete,qn0,n0 - real(r8) :: dt,idt + real(r8) :: dt integer :: i,j,ic,nx,ie logical :: init real(r8), allocatable, dimension(:,:) :: ftmp @@ -44,7 +50,7 @@ subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0) nx=np endif allocate( ftmp(nx*nx,nlev) ) - + init = .false. if ( .not. allocated( adv_tendxyz ) ) then init = .true. @@ -68,7 +74,6 @@ subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0) if ( .not. init ) then dt = get_step_size() - idt = 1._r8/dt do ie=nets,nete do ic = 1,pcnst @@ -85,4 +90,173 @@ subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0) deallocate(ftmp) end subroutine compute_adv_tends_xyz + !---------------------------------------------------------------------- + ! computes camiop specific tendencies + ! and writes these to the camiop file + ! called twice each time step: + ! - first call sets the initial mixing ratios/state + ! - second call computes and outputs the tendencies + !---------------------------------------------------------------------- + subroutine compute_write_iop_fields(elem,fvm,nets,nete,qn0,n0) + use cam_abortutils, only: endrun + use cam_history, only: outfld, hist_fld_active + use time_manager, only: get_step_size + use constituents, only: pcnst,cnst_name + use dimensions_mod, only: nc,np,nlev,use_cslam,npsq + use element_mod, only: element_t + use fvm_control_volume_mod, only: fvm_struct + implicit none + + type (element_t), intent(inout) :: elem(:) + type(fvm_struct), intent(inout) :: fvm(:) + integer, intent(in) :: nets,nete,qn0,n0 + real(r8) :: dt + real(r8), allocatable :: q_new(:,:,:) + real(r8), allocatable :: q_adv(:,:,:) + real(r8), allocatable :: t_adv(:,:) + real(r8), allocatable :: out_q(:,:) + real(r8), allocatable :: out_t(:,:) + real(r8), allocatable :: out_u(:,:) + real(r8), allocatable :: out_v(:,:) + real(r8), allocatable :: out_ps(:) + + integer :: i,j,ic,nx,ie,nxsq,p + integer :: ierr + logical :: init + character(len=*), parameter :: sub = 'compute_write_iop_fields:' + !---------------------------------------------------------------------------- + + if (use_cslam) then + nx=nc + else + nx=np + endif + nxsq=nx*nx + + init = .false. + dt = get_step_size() + + if ( .not. allocated( iop_qtendxyz ) ) then + init = .true. + + allocate( iop_qtendxyz(nx,nx,nlev,pcnst,nets:nete),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate iop_qtendxyz' ) + iop_qtendxyz = 0._r8 + allocate( derivedfq(nx,nx,nlev,pcnst,nets:nete),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate derivedfq' ) + derivedfq = 0._r8 + allocate( iop_qtendxyz_init(nx,nx,nlev,pcnst,nets:nete),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate iop_qtendxyz' ) + iop_qtendxyz_init = 0._r8 + allocate( iop_ttendxyz(nx,nx,nlev,nets:nete),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate iop_ttendxyz' ) + iop_ttendxyz = 0._r8 + allocate( iop_ttendxyz_init(nx,nx,nlev,nets:nete),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate iop_ttendxyz_init' ) + iop_ttendxyz_init = 0._r8 + endif + + ! save initial/calc tendencies on second call to this routine. + if (use_cslam) then + do ie=nets,nete + do ic=1,pcnst + iop_qtendxyz(:,:,:,ic,ie) = fvm(ie)%c(1:nc,1:nc,:,ic) - iop_qtendxyz(:,:,:,ic,ie) + end do + end do + else + do ie=nets,nete + do ic=1,pcnst + iop_qtendxyz(:,:,:,ic,ie) = elem(ie)%state%Qdp(:,:,:,ic,qn0)/elem(ie)%state%dp3d(:,:,:,n0) - iop_qtendxyz(:,:,:,ic,ie) + enddo + end do + end if + do ie=nets,nete + iop_ttendxyz(:,:,:,ie) = elem(ie)%state%T(:,:,:,n0) - iop_ttendxyz(:,:,:,ie) + end do + + if (init) then + do ie=nets,nete + iop_ttendxyz_init(:,:,:,ie) = iop_ttendxyz(:,:,:,ie) + iop_qtendxyz_init(:,:,:,:,ie) = iop_qtendxyz(:,:,:,:,ie) + derivedfq(:,:,:,:,ie)=elem(ie)%derived%FQ(:,:,:,:)/dt + end do + end if + + if ( .not. init ) then + allocate( q_adv(nxsq,nlev,pcnst),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate q_adv' ) + q_adv = 0._r8 + allocate( t_adv(npsq,nlev),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate t_adv' ) + t_adv = 0._r8 + allocate( q_new(nx,nx,nlev),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate q_new' ) + q_new = 0._r8 + allocate( out_q(npsq,nlev),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate out_q' ) + out_q = 0._r8 + allocate( out_t(npsq,nlev),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate out_t' ) + out_t = 0._r8 + allocate( out_u(npsq,nlev),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate out_u' ) + out_u = 0._r8 + allocate( out_v(npsq,nlev),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate out_v' ) + out_v = 0._r8 + allocate( out_ps(npsq),stat=ierr ) + if (ierr/=0) call endrun( sub//': not able to allocate out_ps' ) + out_ps = 0._r8 + do ie=nets,nete + do j=1,nx + do i=1,nx + t_adv(i+(j-1)*np,:) = iop_ttendxyz(i,j,:,ie)/dt - elem(ie)%derived%FT(i,j,:) + out_u(i+(j-1)*np,:) = elem(ie)%state%v(i,j,1,:,n0) + out_v(i+(j-1)*np,:) = elem(ie)%state%v(i,j,2,:,n0) + out_ps(i+(j-1)*np) = elem(ie)%state%psdry(i,j) + + ! to retain bfb, replace state q and t with roundoff version calculated using the ordering and tendencies of the + ! scam prognostic equation + elem(ie)%state%T(i,j,:,n0) = iop_ttendxyz_init(i,j,:,ie) + dt*(elem(ie)%derived%FT(i,j,:) + t_adv(i+(j-1)*np,:)) + out_t(i+(j-1)*np,:) = elem(ie)%state%T(i,j,:,n0) + do p=1,pcnst + q_adv(i+(j-1)*nx,:,p) = iop_qtendxyz(i,j,:,p,ie)/dt - derivedfq(i,j,:,p,ie) + q_new(i,j,:) = iop_qtendxyz_init(i,j,:,p,ie) + dt*(derivedfq(i,j,:,p,ie) + q_adv(i+(j-1)*nx,:,p)) + if (use_cslam) then + fvm(ie)%c(i,j,:,p)=q_new(i,j,:) + else + elem(ie)%state%Qdp(i,j,:,p,qn0)=q_new(i,j,:)*elem(ie)%state%dp3d(i,j,:,n0) + end if + enddo + out_q(i+(j-1)*nx,:) = elem(ie)%state%Qdp(i,j,:,1,qn0)/elem(ie)%state%dp3d(i,j,:,n0) + end do + end do + call outfld('Ps',out_ps,npsq,ie) + call outfld('t',out_t,npsq,ie) + call outfld('q',out_q,nxsq,ie) + call outfld('u',out_u,npsq,ie) + call outfld('v',out_v,npsq,ie) + call outfld('divT3d',t_adv,npsq,ie) + do p=1,pcnst + call outfld(trim(cnst_name(p))//'_dten',q_adv(:,:,p),nxsq,ie) + enddo + end do + + deallocate(iop_ttendxyz) + deallocate(iop_ttendxyz_init) + deallocate(iop_qtendxyz) + deallocate(iop_qtendxyz_init) + deallocate(derivedfq) + deallocate(out_t) + deallocate(out_q) + deallocate(out_u) + deallocate(out_v) + deallocate(out_ps) + deallocate(t_adv) + deallocate(q_adv) + deallocate(q_new) + + endif + end subroutine compute_write_iop_fields + end module advect_tend diff --git a/src/dynamics/se/apply_iop_forcing.F90 b/src/dynamics/se/apply_iop_forcing.F90 new file mode 100644 index 0000000000..06e2a48472 --- /dev/null +++ b/src/dynamics/se/apply_iop_forcing.F90 @@ -0,0 +1,238 @@ +module apply_iop_forcing_mod + +use shr_kind_mod, only:r8 => shr_kind_r8, i8 => shr_kind_i8 +use pmgrid, only:plev, plevp, plon +use constituents, only:pcnst, cnst_get_ind, cnst_name +use physconst, only:rair,cpair +use cam_logfile, only:iulog +use hybvcoord_mod, only: hvcoord_t +use scamMod, only: use_3dfrc, single_column, have_u, have_v, divT3d, divq3d, divt, divq, & + wfld, uobs, vobs, tobs, qobs, plevs0, have_divt3d, have_divq3d, & + scm_relax_bot_p,scm_relax_linear,scm_relax_tau_bot_sec, & + scm_relax_tau_sec,scm_relax_tau_top_sec,scm_relax_top_p, & + scm_relaxation,scm_relax_fincl,qinitobs + +use cam_abortutils, only: endrun +use string_utils, only: to_upper + +implicit none + +public advance_iop_forcing +public advance_iop_nudging + +!========================================================================= +contains +!========================================================================= + +subroutine advance_iop_forcing(scm_dt, ps_in, & ! In + u_in, v_in, t_in, q_in, t_phys_frc, q_phys_frc, hvcoord, & ! In + u_update, v_update, t_update, q_update) ! Out + +!----------------------------------------------------------------------- +! +! Purpose: +! Apply large scale forcing for t, q, u, and v as provided by the +! case IOP forcing file. +! +! Author: +! Original version: Adopted from CAM3.5/CAM5 +! Updated version for E3SM: Peter Bogenschutz (bogenschutz1@llnl.gov) +! and replaces the forecast.F90 routine in CAM3.5/CAM5/CAM6/E3SMv1/E3SMv2 +! +!----------------------------------------------------------------------- + + ! Input arguments + real(r8), intent(in) :: ps_in ! surface pressure [Pa] + real(r8), intent(in) :: u_in(plev) ! zonal wind [m/s] + real(r8), intent(in) :: v_in(plev) ! meridional wind [m/s] + real(r8), intent(in) :: t_in(plev) ! temperature [K] + real(r8), intent(in) :: q_in(plev,pcnst) ! q tracer array [units vary] already vertically advected + real(r8), intent(in) :: t_phys_frc(plev) ! temperature forcing from physics [K/s] + real(r8), intent(in) :: q_phys_frc(plev,pcnst) ! change in q due to physics. + type (hvcoord_t), intent(in) :: hvcoord + real(r8), intent(in) :: scm_dt ! model time step [s] + + ! Output arguments + real(r8), intent(out) :: t_update(plev) ! updated temperature [K] + real(r8), intent(out) :: q_update(plev,pcnst)! updated q tracer array [units vary] + real(r8), intent(out) :: u_update(plev) ! updated zonal wind [m/s] + real(r8), intent(out) :: v_update(plev) ! updated meridional wind [m/s] + + ! Local variables + real(r8) pmidm1(plev) ! pressure at model levels + real(r8) pintm1(plevp) ! pressure at model interfaces + real(r8) pdelm1(plev) ! pdel(k) = pint (k+1)-pint (k) + real(r8) t_lsf(plev) ! storage for temperature large scale forcing + real(r8) q_lsf(plev,pcnst) ! storage for moisture large scale forcing + real(r8) fac, t_expan + + integer i,k,m ! longitude, level, constituent indices + + character(len=*), parameter :: subname = 'advance_iop_forcing' + + ! Get vertical level profiles + call plevs0(plev, ps_in, hvcoord%ps0, hvcoord%hyam, hvcoord%hybm, hvcoord%hyai, hvcoord%hybi, pintm1 ,pmidm1 ,pdelm1) + + ! Advance T and Q due to large scale forcing + if (use_3dfrc) then + if(.not.(have_divt3d.and.have_divq3d)) call endrun(subname//": FATAL: divt3d and divq3d not available") + t_lsf(:plev) = divt3d(:plev) + q_lsf(:plev,:pcnst) = divq3d(:plev,:pcnst) + else + t_lsf(:plev) = divt(:plev) + q_lsf(:plev,:pcnst) = divq(:plev,:pcnst) + endif + + do k=1,plev + ! Initialize thermal expansion term to zero. This term is only + ! considered if three dimensional forcing is not provided by IOP forcing file. + t_expan = 0._r8 + + if (.not. use_3dfrc) then + t_expan = scm_dt*wfld(k)*t_in(k)*rair/(cpair*pmidm1(k)) + endif + + if (use_3dfrc) then + do m=1,pcnst + ! When using 3d dynamics tendencies, SCM skips the vertical advection step and thus + ! q_in at this point has not had physics tendencies applied + q_update(k,m) = q_in(k,m) + scm_dt*(q_phys_frc(k,m) + q_lsf(k,m)) + end do + t_update(k) = t_in(k) + t_expan + scm_dt*(t_phys_frc(k) + t_lsf(k)) + else + do m=1,pcnst + ! When not using 3d dynamics tendencies, q_in at this point has had physics tend + ! applied and has been vertically advected. Only horizontal dyn tend needed for forecast. + q_update(k,m) = q_in(k,m) + scm_dt*q_lsf(k,m) + end do + t_update(k) = t_in(k) + t_expan + scm_dt*t_lsf(k) + end if + end do + + ! Set U and V fields + + if ( have_v .and. have_u ) then + do k=1,plev + u_update(k) = uobs(k) + v_update(k) = vobs(k) + enddo + endif + +end subroutine advance_iop_forcing + +!========================================================================= + +subroutine advance_iop_nudging(ztodt, ps_in, & ! In + tfcst, qfcst, ufcst, vfcst, hvcoord, & ! Inout + relaxt, relaxq ) ! Out + + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Option to nudge t and q to observations as specified by the IOP file + !----------------------------------------------------------------------- + + ! Input arguments + real(r8), intent(in) :: ztodt ! model time step [s] + real(r8), intent(in) :: ps_in ! surface pressure [Pa] + type (hvcoord_t), intent(in) :: hvcoord + + ! Output arguments + real(r8), intent(inout) :: tfcst(plev) ! updated temperature [K] + real(r8), intent(inout) :: qfcst(plon,plev,pcnst) ! updated const field + real(r8), intent(inout) :: ufcst(plev) ! updated U wind + real(r8), intent(inout) :: vfcst(plev) ! updated V wind + real(r8), intent(out) :: relaxt(plev) ! relaxation of temperature [K/s] + real(r8), intent(out) :: relaxq(plev) ! relaxation of vapor [kg/kg/s] + + ! Local variables + integer :: i, k, m + real(r8) pmidm1(plev) ! pressure at model levels + real(r8) pintm1(plevp) ! pressure at model interfaces + real(r8) pdelm1(plev) ! pdel(k) = pint (k+1)-pint (k) + + ! --------------------------- ! + ! For 'scm_relaxation' switch ! + ! --------------------------- ! + + real(r8) rtau(plev) + real(r8) relax_T(plev) + real(r8) relax_u(plev) + real(r8) relax_v(plev) + real(r8) relax_q(plev,pcnst) + ! +++BPM: allow linear relaxation profile + real(r8) rslope ! [optional] slope for linear relaxation profile + real(r8) rycept ! [optional] y-intercept for linear relaxtion profile + logical scm_fincl_empty + + ! ------------------------------------------------------------------- ! + ! Relaxation to the observed or specified state ! + ! We should specify relaxation time scale ( rtau ) and ! + ! target-relaxation state ( in the current case, either 'obs' or 0 ) ! + ! ------------------------------------------------------------------- ! + + if ( .not. scm_relaxation) return + + call plevs0(plev, ps_in, hvcoord%ps0, hvcoord%hyam, hvcoord%hybm, hvcoord%hyai, hvcoord%hybi, pintm1 ,pmidm1 ,pdelm1) + + relax_T(:) = 0._r8 + relax_u(:) = 0._r8 + relax_v(:) = 0._r8 + relax_q(:plev,:pcnst) = 0._r8 + ! +++BPM: allow linear relaxation profile + ! scm_relaxation is a logical from scamMod + ! scm_relax_tau_top_sec and scm_relax_tau_bot_sec are the relaxation times at top and bottom of layer + ! also defined in scamMod + if ( scm_relax_linear ) then + rslope = (scm_relax_top_p - scm_relax_bot_p)/(scm_relax_tau_top_sec - scm_relax_tau_bot_sec) + rycept = scm_relax_tau_top_sec - (rslope*scm_relax_top_p) + endif + + scm_fincl_empty=.true. + do i=1,pcnst + if (len_trim(scm_relax_fincl(i)) > 0) then + scm_fincl_empty=.false. + scm_relax_fincl(i)=trim(to_upper(scm_relax_fincl(i))) + end if + end do + + do k = 1, plev + if ( pmidm1(k) <= scm_relax_bot_p.and.pmidm1(k) >= scm_relax_top_p ) then ! inside layer + if (scm_relax_linear) then + rtau(k) = rslope*pmidm1(k) + rycept ! linear regime + else + rtau(k) = max( ztodt, scm_relax_tau_sec ) ! constant for whole layer / no relax outside + endif + else if (scm_relax_linear .and. pmidm1(k) <= scm_relax_top_p ) then ! not linear => do nothing / linear => use upper value + rtau(k) = scm_relax_tau_top_sec ! above layer keep rtau equal to the top + endif + ! +BPM: this can't be the best way... + ! I put this in because if rtau doesn't get set above, then I don't want to do any relaxation in that layer. + ! maybe the logic of this whole loop needs to be re-thinked. + if (rtau(k) /= 0) then + relax_T(k) = - ( tfcst(k) - tobs(k) ) / rtau(k) + relax_u(k) = - ( ufcst(k) - uobs(k) ) / rtau(k) + relax_v(k) = - ( vfcst(k) - vobs(k) ) / rtau(k) + relax_q(k,1) = - ( qfcst(1,k,1) - qobs(k) ) / rtau(k) + do m = 2, pcnst + relax_q(k,m) = - ( qfcst(1,k,m) - qinitobs(k,m) ) / rtau(k) + enddo + if (scm_fincl_empty .or. ANY(scm_relax_fincl(:) == 'T')) & + tfcst(k) = tfcst(k) + relax_T(k) * ztodt + if (scm_fincl_empty .or.ANY(scm_relax_fincl(:) == 'U')) & + ufcst(k) = ufcst(k) + relax_u(k) * ztodt + if (scm_fincl_empty .or. ANY(scm_relax_fincl(:) == 'V')) & + vfcst(k) = vfcst(k) + relax_v(k) * ztodt + do m = 1, pcnst + if (scm_fincl_empty .or. ANY(scm_relax_fincl(:) == trim(to_upper(cnst_name(m)))) ) then + qfcst(1,k,m) = qfcst(1,k,m) + relax_q(k,m) * ztodt + end if + enddo + end if + enddo + +end subroutine advance_iop_nudging + +!----------------------------------------------------------------------- + +end module apply_iop_forcing_mod diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 61b7fc54e9..919b7f3510 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -15,7 +15,7 @@ module dp_coupling use physics_types, only: physics_state, physics_tend, physics_cnst_limit use phys_grid, only: get_ncols_p -use phys_grid, only: get_dyn_col_p, columns_on_task, get_chunk_info_p +use phys_grid, only: get_dyn_col_p, columns_on_task, get_chunk_info_p, phys_columns_on_task use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_get_field use dp_mapping, only: nphys_pts @@ -224,7 +224,7 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) allocate(frontga_phys(pcols, pver, begchunk:endchunk)) end if !$omp parallel do num_threads(max_num_threads) private (col_ind, lchnk, icol, ie, blk_ind, ilyr, m) - do col_ind = 1, columns_on_task + do col_ind = 1, phys_columns_on_task call get_dyn_col_p(col_ind, ie, blk_ind) call get_chunk_info_p(col_ind, lchnk, icol) phys_state(lchnk)%ps(icol) = ps_tmp(blk_ind(1), ie) @@ -306,13 +306,13 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) ! Convert the physics output state into the dynamics input state. - use phys_grid, only: get_dyn_col_p, columns_on_task, get_chunk_info_p + use phys_grid, only: get_dyn_col_p, columns_on_task, get_chunk_info_p, phys_columns_on_task use bndry_mod, only: bndry_exchange use edge_mod, only: edgeVpack, edgeVunpack 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 @@ -383,7 +383,7 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) call t_startf('pd_copy') !$omp parallel do num_threads(max_num_threads) private (col_ind, lchnk, icol, ie, blk_ind, ilyr, m) - do col_ind = 1, columns_on_task + do col_ind = 1, phys_columns_on_task call get_dyn_col_p(col_ind, ie, blk_ind) call get_chunk_info_p(col_ind, lchnk, icol) @@ -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/interpolate_mod.F90 b/src/dynamics/se/dycore/interpolate_mod.F90 index 65e1e26c9b..55093dad73 100644 --- a/src/dynamics/se/dycore/interpolate_mod.F90 +++ b/src/dynamics/se/dycore/interpolate_mod.F90 @@ -1625,8 +1625,8 @@ subroutine interpolate_vector2d(interpdata,elem,fld_cube,npts,fld,input_coords, if (npts==np) then interp => interp_p - else if (npts==np) then - call endrun('interpolate_vector2d: Error in interpolate_vector(): input must be on velocity grid') + else + call endrun('interpolate_vector2d: Error in interpolate_vector(): input must be on GLL grid') endif @@ -1715,8 +1715,8 @@ subroutine interpolate_vector3d(interpdata,elem,fld_cube,npts,nlev,fld,input_coo if (npts==np) then interp => interp_p - else if (npts==np) then - call endrun('interpolate_vector3d: Error in interpolate_vector(): input must be on velocity grid') + else + call endrun('interpolate_vector3d: Error in interpolate_vector(): input must be on GLL grid') endif diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index ed7a627ec4..018c281253 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 @@ -505,7 +508,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,'dBH') rhypervis_subcycle=1.0_r8/real(hypervis_subcycle,kind=r8) - call biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend,hvcoord) + call biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend) do ie=nets,nete ! compute mean flux @@ -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..e2d470f616 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) @@ -163,7 +163,7 @@ subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) do k=1,nlev pmid_ref =hvcoord%hyam(k)*hvcoord%ps0 + hvcoord%hybm(k)*ps_ref(:,:,ie) dp0 = ( hvcoord%hyai(k+1) - hvcoord%hyai(k) )*hvcoord%ps0 + & - ( hvcoord%hybi(k+1) - hvcoord%hybi(k) )*hvcoord%ps0 + ( hvcoord%hybi(k+1) - hvcoord%hybi(k) )*hvcoord%ps0 if (hvcoord%hybm(k)>0) then elem(ie)%derived%T_ref(:,:,k) = T0+T1*(pmid_ref/hvcoord%ps0)**cappa ! @@ -184,7 +184,7 @@ end subroutine prim_init2 !=======================================================================================================! - subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubstep, omega_cn) + subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubstep, single_column, omega_cn) ! ! advance all variables (u,v,T,ps,Q,C) from time t to t + dt_q ! @@ -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) @@ -238,14 +238,14 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst real(kind=r8), intent(in) :: dt ! "timestep dependent" timestep type (TimeLevel_t), intent(inout):: tl integer, intent(in) :: nsubstep ! nsubstep = 1 .. nsplit - real (kind=r8) , intent(inout):: omega_cn(2,nets:nete) !min and max of vertical Courant number + logical, intent(in) :: single_column + real (kind=r8) , intent(inout):: omega_cn(2,nets:nete) !min and max of vertical Courant number real(kind=r8) :: dt_q, dt_remap, dt_phys integer :: ie, q,k,n0_qdp,np1_qdp,r, nstep_end,region_num_threads,i,j 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 ! =================================== @@ -266,7 +266,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst ! ! initialize variables for computing vertical Courant number ! - if (variable_nsplit.or.compute_diagnostics) then + if (variable_nsplit.or.compute_diagnostics) then if (nsubstep==1) then do ie=nets,nete omega_cn(1,ie) = 0.0_r8 @@ -282,15 +282,42 @@ 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') + if (single_column) then + ! Single Column Case + ! Loop over rsplit vertically lagrangian timesteps + call prim_step_scm(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r) + else + call prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r,nsubstep==nsplit,dt_remap) + end if + call tot_energy_dyn(elem,fvm,nets,nete,tl%np1,n0_qdp,'dAL') enddo - + ! defer final timelevel update until after remap and diagnostics call TimeLevel_Qdp( tl, qsplit, n0_qdp, np1_qdp) @@ -300,12 +327,12 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst ! always for tracers !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call tot_energy_dyn(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAD') + call tot_energy_dyn(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAD') if (variable_nsplit.or.compute_diagnostics) then ! ! initialize variables for computing vertical Courant number - ! + ! do ie=nets,nete dp_end(:,:,:,ie) = elem(ie)%state%dp3d(:,:,:,tl%np1) end do @@ -319,8 +346,8 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! call tot_energy_dyn(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAR') - if (nsubstep==nsplit) then - call compute_omega(hybrid,tl%np1,np1_qdp,elem,deriv,nets,nete,dt_remap,hvcoord) + if (nsubstep==nsplit.and. .not. single_column) then + call compute_omega(hybrid,tl%np1,np1_qdp,elem,deriv,nets,nete,dt_remap,hvcoord) end if ! now we have: @@ -363,7 +390,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 +415,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,11 +444,12 @@ 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 - +#endif + type (element_t) , intent(inout) :: elem(:) type(fvm_struct), intent(inout) :: fvm(:) @@ -433,6 +460,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 +469,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 +547,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,36 +566,23 @@ 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 ! - if ((mod(rstep,fvm_supercycling) == 0).and.(mod(rstep,fvm_supercycling_jet) == 0)) then + if ((mod(rstep,fvm_supercycling) == 0).and.(mod(rstep,fvm_supercycling_jet) == 0)) then ! call omp_set_nested(.true.) ! !$OMP PARALLEL NUM_THREADS(vert_num_threads), DEFAULT(SHARED), PRIVATE(hybridnew2,kbeg,kend) @@ -594,14 +610,16 @@ 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 ! call Prim_Advec_Tracers_fvm(elem,fvm,hvcoord,hybrid,& dt_q,tl,nets,nete,ghostBufQnhcJet_h,ghostBufQ1_h, ghostBufFluxJet_h,kmin_jet,kmax_jet) - end if + end if #ifdef waccm_debug do ie=nets,nete @@ -609,11 +627,84 @@ 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 + subroutine prim_step_scm(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) + ! + ! prim_step version for single column model (SCM) + ! Here we simply want to compute the floating level tendency + ! based on the prescribed large scale vertical velocity + ! Take qsplit dynamics steps and one tracer step + ! for vertically lagrangian option, this subroutine does only + ! the horizontal step + ! + ! input: + ! tl%nm1 not used + ! tl%n0 data at time t + ! tl%np1 new values at t+dt_q + ! + ! then we update timelevel pointers: + ! tl%nm1 = tl%n0 + ! tl%n0 = tl%np1 + ! so that: + ! tl%nm1 tracers: t dynamics: t+(qsplit-1)*dt + ! tl%n0 time t + dt_q + ! + use hybvcoord_mod, only: hvcoord_t + use se_dyn_time_mod, only: TimeLevel_t, timelevel_update + use control_mod, only: statefreq, qsplit, nu_p + use prim_advection_mod, only: deriv + use hybrid_mod, only: config_thread_region, get_loop_ranges + + type (element_t) , intent(inout) :: elem(:) + type(fvm_struct), intent(inout) :: fvm(:) + type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) + type (hvcoord_t), intent(in) :: hvcoord ! hybrid vertical coordinate struct + integer, intent(in) :: nets ! starting thread element number (private) + integer, intent(in) :: nete ! ending thread element number (private) + real(kind=r8), intent(in) :: dt ! "timestep dependent" timestep + type (TimeLevel_t), intent(inout) :: tl + integer, intent(in) :: rstep ! vertical remap subcycling step + + integer :: ie,n + + ! =============== + ! initialize mean flux accumulation variables and save some variables at n0 + ! for use by advection + ! =============== + do ie=nets,nete + elem(ie)%derived%vn0=0 ! mean horizontal mass flux + if (nu_p>0) then + elem(ie)%derived%dpdiss_ave=0 + elem(ie)%derived%dpdiss_biharmonic=0 + endif + elem(ie)%derived%dp(:,:,:)=elem(ie)%state%dp3d(:,:,:,tl%n0) + enddo + ! =============== + ! Dynamical Step + ! =============== + call t_startf('set_prescribed_scm') + + call set_prescribed_scm(elem, fvm, deriv, hvcoord, & + hybrid, dt, tl, nets, nete) + + call t_stopf('set_prescribed_scm') + + do n=2,qsplit + call TimeLevel_update(tl,"leapfrog") + + call t_startf('set_prescribed_scm') + + call set_prescribed_scm(elem, fvm, deriv, hvcoord, & + hybrid, dt, tl, nets, nete) + + call t_stopf('set_prescribed_scm') + enddo + + end subroutine prim_step_scm !=======================================================================================================! @@ -718,4 +809,62 @@ subroutine get_global_ave_surface_pressure(elem, global_ave_ps_inic) deallocate(tmp) end subroutine get_global_ave_surface_pressure + subroutine set_prescribed_scm(elem, fvm, deriv, hvcoord, & + hybrid, dt, tl, nets, nete) + use control_mod, only: tstep_type, qsplit + use derivative_mod, only: derivative_t + use dimensions_mod, only: np, nlev + use element_mod, only: element_t + use hybvcoord_mod, only: hvcoord_t + use hybrid_mod, only: hybrid_t + use se_dyn_time_mod, only: TimeLevel_t, timelevel_qdp + use fvm_control_volume_mod, only: fvm_struct + implicit none + + type (element_t), intent(inout), target :: elem(:) + type(fvm_struct) , intent(inout) :: fvm(:) + type (derivative_t) , intent(in) :: deriv + type (hvcoord_t) :: hvcoord + type (hybrid_t) , intent(in) :: hybrid + real (kind=r8), intent(in) :: dt + type (TimeLevel_t) , intent(in) :: tl + integer , intent(in) :: nets + integer , intent(in) :: nete + + ! Local + integer :: ie,nm1,n0,np1,k,qn0,qnp1,p + real(kind=r8) :: eta_dot_dpdn(np,np,nlev+1) + + + nm1 = tl%nm1 + n0 = tl%n0 + np1 = tl%np1 + + call TimeLevel_Qdp(tl, qsplit, qn0, qnp1) ! compute current Qdp() timelevel + + do ie=nets,nete + do k=1,nlev + eta_dot_dpdn(:,:,k)=elem(ie)%derived%omega(:,:,k) + enddo + eta_dot_dpdn(:,:,nlev+1) = eta_dot_dpdn(:,:,nlev) + + do k=1,nlev + elem(ie)%state%dp3d(:,:,k,np1) = elem(ie)%state%dp3d(:,:,k,n0) & + + dt*(eta_dot_dpdn(:,:,k+1) - eta_dot_dpdn(:,:,k)) + enddo + + do k=1,nlev + elem(ie)%state%T(:,:,k,np1) = elem(ie)%state%T(:,:,k,n0) + enddo + + do p=1,qsize + do k=1,nlev + elem(ie)%state%Qdp(:,:,k,p,qnp1) = elem(ie)%state%Qdp(:,:,k,p,qn0) & + + elem(ie)%state%Qdp(:,:,k,p,qn0)/elem(ie)%state%dp3d(:,:,k,n0) * & + dt*(eta_dot_dpdn(:,:,k+1) - eta_dot_dpdn(:,:,k)) + enddo + enddo + enddo + end subroutine set_prescribed_scm + end module prim_driver_mod 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/vertremap_mod.F90 b/src/dynamics/se/dycore/vertremap_mod.F90 index 3b57fd891e..59fc6afddd 100644 --- a/src/dynamics/se/dycore/vertremap_mod.F90 +++ b/src/dynamics/se/dycore/vertremap_mod.F90 @@ -17,7 +17,6 @@ module vertremap_mod use shr_kind_mod, only: r8=>shr_kind_r8 use dimensions_mod, only: np,nlev,qsize,nlevp,npsq,nc - use hybvcoord_mod, only: hvcoord_t use element_mod, only: element_t use fvm_control_volume_mod, only: fvm_struct use perf_mod, only: t_startf, t_stopf ! _EXTERNAL @@ -25,7 +24,7 @@ module vertremap_mod use cam_abortutils, only: endrun implicit none - + public remap1 ! remap any field, splines, monotone public remap1_nofilter ! remap any field, splines, no filter ! todo: tweak interface to match remap1 above, rename remap1_ppm: @@ -65,19 +64,19 @@ subroutine remap1(Qdp,nx,qstart,qstop,qsize,dp1,dp2,ptop,identifier,Qdp_mass,kor if (any(kord(:) >= 0)) then if (.not.qdp_mass) then do itrac=1,qsize - if (kord(itrac) >= 0) then + if (kord(itrac) >= 0) then Qdp(:,:,:,itrac) = Qdp(:,:,:,itrac)*dp1(:,:,:) end if end do - end if + end if call remap_Q_ppm(qdp,nx,qstart,qstop,qsize,dp1,dp2,kord) if (.not.qdp_mass) then do itrac=1,qsize - if (kord(itrac) >= 0) then + if (kord(itrac) >= 0) then Qdp(:,:,:,itrac) = Qdp(:,:,:,itrac)/dp2(:,:,:) end if end do - end if + end if endif if (any(kord(:)<0)) then ! @@ -89,20 +88,20 @@ subroutine remap1(Qdp,nx,qstart,qstop,qsize,dp1,dp2,ptop,identifier,Qdp_mass,kor kord_local = abs(kord) logp = .false. else - kord_local = abs(kord/10) + kord_local = abs(kord/10) if (identifier==1) then logp = .true. else - logp = .false. + logp = .false. end if end if ! ! modified FV3 vertical remapping - ! + ! if (qdp_mass) then inv_dp = 1.0_r8/dp1 do itrac=1,qsize - if (kord(itrac)<0) then + if (kord(itrac)<0) then Qdp(:,:,:,itrac) = Qdp(:,:,:,itrac)*inv_dp(:,:,:) end if end do @@ -124,7 +123,7 @@ subroutine remap1(Qdp,nx,qstart,qstop,qsize,dp1,dp2,ptop,identifier,Qdp_mass,kor pe2(i,k) = log(pe2(i,k)) end do end do - + do itrac=1,qsize if (kord(itrac)<0) then call map1_ppm( nlev, pe1(:,:), Qdp(:,:,:,itrac), gz, & @@ -457,7 +456,7 @@ subroutine binary_search(pio, pivot, k) real(kind=r8), intent(in) :: pio(nlev+2), pivot integer, intent(inout) :: k integer :: lo, hi, mid - + if (pio(k) > pivot) then lo = 1 hi = k @@ -597,7 +596,7 @@ subroutine linextrap(dx1,dx2,dx3,dx4,y1,y2,y3,y4,lo,hi) y4 = (1.0_r8-a)*y1 + a*y2 y3 = max(lo, min(hi, y3)) y4 = max(lo, min(hi, y4)) - end subroutine linextrap + end subroutine linextrap end module vertremap_mod !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/src/dynamics/se/dycore/viscosity_mod.F90 b/src/dynamics/se/dycore/viscosity_mod.F90 index 04b0a1a91d..51bf63a3da 100644 --- a/src/dynamics/se/dycore/viscosity_mod.F90 +++ b/src/dynamics/se/dycore/viscosity_mod.F90 @@ -1,9 +1,9 @@ module viscosity_mod ! ! This module should be renamed "global_deriv_mod.F90" -! -! It is a collection of derivative operators that must be applied to the field -! over the sphere (as opposed to derivative operators that can be applied element +! +! It is a collection of derivative operators that must be applied to the field +! over the sphere (as opposed to derivative operators that can be applied element ! by element) ! ! @@ -50,10 +50,9 @@ module viscosity_mod CONTAINS -subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend,hvcoord) +subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend) use derivative_mod, only : subcell_Laplace_fluxes use dimensions_mod, only : use_cslam, nu_div_lev,nu_lev - use hybvcoord_mod, only : hvcoord_t !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! compute weak biharmonic operator ! input: h,v (stored in elem()%, in lat-lon coordinates @@ -69,25 +68,24 @@ subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid, real (kind=r8), dimension(np,np,nlev,nets:nete) :: ttens,dptens type (EdgeBuffer_t) , intent(inout) :: edge3 type (derivative_t) , intent(in) :: deriv - type (hvcoord_t) , intent(in) :: hvcoord ! local integer :: i,j,k,kptr,ie,kblk ! real (kind=r8), dimension(:,:), pointer :: rspheremv real (kind=r8), dimension(np,np) :: tmp real (kind=r8), dimension(np,np) :: tmp2 real (kind=r8), dimension(np,np,2) :: v - + real (kind=r8), dimension(np,np,nlev) :: lap_p_wk real (kind=r8), dimension(np,np,nlevp) :: T_i real (kind=r8) :: nu_ratio1, nu_ratio2, dp_thresh logical var_coef1 - + kblk = kend - kbeg + 1 - + if (use_cslam) dpflux = 0 - !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) + !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) !so tensor is only used on second call to laplace_sphere_wk var_coef1 = .true. if(hypervis_scaling > 0) var_coef1 = .false. @@ -123,10 +121,10 @@ subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid, kptr = kbeg - 1 call edgeVpack(edge3,ttens(:,:,kbeg:kend,ie),kblk,kptr,ie) - kptr = kbeg - 1 + nlev + kptr = kbeg - 1 + nlev call edgeVpack(edge3,vtens(:,:,1,kbeg:kend,ie),kblk,kptr,ie) - kptr = kbeg - 1 + 2*nlev + kptr = kbeg - 1 + 2*nlev call edgeVpack(edge3,vtens(:,:,2,kbeg:kend,ie),kblk,kptr,ie) kptr = kbeg - 1 + 3*nlev @@ -137,7 +135,7 @@ subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid, do ie=nets,nete !CLEAN rspheremv => elem(ie)%rspheremp(:,:) - + kptr = kbeg - 1 call edgeVunpack(edge3,ttens(:,:,kbeg:kend,ie),kblk,kptr,ie) @@ -157,7 +155,7 @@ subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid, call subcell_Laplace_fluxes(tmp, deriv, elem(ie), np, nc,dpflux(:,:,:,k,ie)) enddo endif - + ! apply inverse mass matrix, then apply laplace again !$omp parallel do num_threads(vert_num_threads) private(k,v,tmp,tmp2) do k=kbeg,kend @@ -198,37 +196,37 @@ subroutine biharmonic_wk_omega(elem,ptens,deriv,edge3,hybrid,nets,nete,kbeg,kend real (kind=r8), dimension(np,np,2) :: v real (kind=r8) :: nu_ratio1, nu_ratio2 logical var_coef1 - + kblk = kend - kbeg + 1 - - !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) + + !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) !so tensor is only used on second call to laplace_sphere_wk var_coef1 = .true. if(hypervis_scaling > 0) var_coef1 = .false. - + nu_ratio1=1 nu_ratio2=1 - + do ie=nets,nete - + !$omp parallel do num_threads(vert_num_threads) private(k,tmp) do k=kbeg,kend - tmp=elem(ie)%derived%omega(:,:,k) + tmp=elem(ie)%derived%omega(:,:,k) call laplace_sphere_wk(tmp,deriv,elem(ie),ptens(:,:,k,ie),var_coef=var_coef1) enddo - + kptr = kbeg - 1 call edgeVpack(edge3,ptens(:,:,kbeg:kend,ie),kblk,kptr,ie) enddo - + call bndry_exchange(hybrid,edge3,location='biharmonic_wk_omega') - + do ie=nets,nete rspheremv => elem(ie)%rspheremp(:,:) - + kptr = kbeg - 1 call edgeVunpack(edge3,ptens(:,:,kbeg:kend,ie),kblk,kptr,ie) - + ! apply inverse mass matrix, then apply laplace again !$omp parallel do num_threads(vert_num_threads) private(k,tmp) do k=kbeg,kend @@ -256,14 +254,14 @@ subroutine biharmonic_wk_scalar(elem,qtens,deriv,edgeq,hybrid,nets,nete) ! local integer :: k,kptr,i,j,ie,ic,q -integer :: kbeg,kend,qbeg,qend +integer :: kbeg,kend,qbeg,qend real (kind=r8), dimension(np,np) :: lap_p logical var_coef1 integer :: kblk,qblk ! The per thead size of the vertical and tracers call get_loop_ranges(hybrid,kbeg=kbeg,kend=kend,qbeg=qbeg,qend=qend) - !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) + !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) !so tensor is only used on second call to laplace_sphere_wk var_coef1 = .true. if(hypervis_scaling > 0) var_coef1 = .false. @@ -273,7 +271,7 @@ subroutine biharmonic_wk_scalar(elem,qtens,deriv,edgeq,hybrid,nets,nete) qblk = qend - qbeg + 1 ! calculate size of the block of tracers do ie=nets,nete - do q=qbeg,qend + do q=qbeg,qend do k=kbeg,kend lap_p(:,:)=qtens(:,:,k,q,ie) call laplace_sphere_wk(lap_p,deriv,elem(ie),qtens(:,:,k,q,ie),var_coef=var_coef1) @@ -285,11 +283,11 @@ subroutine biharmonic_wk_scalar(elem,qtens,deriv,edgeq,hybrid,nets,nete) call bndry_exchange(hybrid,edgeq,location='biharmonic_wk_scalar') - + do ie=nets,nete ! apply inverse mass matrix, then apply laplace again - do q=qbeg,qend + do q=qbeg,qend kptr = nlev*(q-1) + kbeg - 1 call edgeVunpack(edgeq, qtens(:,:,kbeg:kend,q,ie),kblk,kptr,ie) do k=kbeg,kend @@ -305,7 +303,7 @@ end subroutine biharmonic_wk_scalar subroutine make_C0(zeta,elem,hybrid,nets,nete) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! apply DSS (aka assembly procedure) to zeta. +! apply DSS (aka assembly procedure) to zeta. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type (hybrid_t) , intent(in) :: hybrid @@ -341,7 +339,7 @@ subroutine make_C0(zeta,elem,hybrid,nets,nete) enddo enddo -call FreeEdgeBuffer(edge1) +call FreeEdgeBuffer(edge1) end subroutine @@ -409,7 +407,7 @@ subroutine make_C0_vector(v,elem,hybrid,nets,nete) enddo enddo -call FreeEdgeBuffer(edge2) +call FreeEdgeBuffer(edge2) #endif end subroutine @@ -420,11 +418,11 @@ subroutine make_C0_vector(v,elem,hybrid,nets,nete) subroutine compute_zeta_C0_contra(zeta,elem,hybrid,nets,nete,nt) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute C0 vorticity. That is, solve: +! compute C0 vorticity. That is, solve: ! < PHI, zeta > = ! ! input: v (stored in elem()%, in contra-variant coordinates) -! output: zeta(:,:,:,:) +! output: zeta(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -459,11 +457,11 @@ subroutine compute_zeta_C0_contra(zeta,elem,hybrid,nets,nete,nt) subroutine compute_div_C0_contra(zeta,elem,hybrid,nets,nete,nt) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute C0 divergence. That is, solve: +! compute C0 divergence. That is, solve: ! < PHI, zeta > = ! ! input: v (stored in elem()%, in contra-variant coordinates) -! output: zeta(:,:,:,:) +! output: zeta(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -496,11 +494,11 @@ subroutine compute_div_C0_contra(zeta,elem,hybrid,nets,nete,nt) subroutine compute_zeta_C0_par(zeta,elem,par,nt) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute C0 vorticity. That is, solve: +! compute C0 vorticity. That is, solve: ! < PHI, zeta > = ! ! input: v (stored in elem()%, in lat-lon coordinates) -! output: zeta(:,:,:,:) +! output: zeta(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type (parallel_t) :: par @@ -523,11 +521,11 @@ subroutine compute_zeta_C0_par(zeta,elem,par,nt) subroutine compute_div_C0_par(zeta,elem,par,nt) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute C0 divergence. That is, solve: +! compute C0 divergence. That is, solve: ! < PHI, zeta > = ! ! input: v (stored in elem()%, in lat-lon coordinates) -! output: zeta(:,:,:,:) +! output: zeta(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -552,11 +550,11 @@ subroutine compute_div_C0_par(zeta,elem,par,nt) subroutine compute_zeta_C0_hybrid(zeta,elem,hybrid,nets,nete,nt) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute C0 vorticity. That is, solve: +! compute C0 vorticity. That is, solve: ! < PHI, zeta > = ! ! input: v (stored in elem()%, in lat-lon coordinates) -! output: zeta(:,:,:,:) +! output: zeta(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -587,11 +585,11 @@ subroutine compute_zeta_C0_hybrid(zeta,elem,hybrid,nets,nete,nt) subroutine compute_div_C0_hybrid(zeta,elem,hybrid,nets,nete,nt) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute C0 divergence. That is, solve: +! compute C0 divergence. That is, solve: ! < PHI, zeta > = ! ! input: v (stored in elem()%, in lat-lon coordinates) -! output: zeta(:,:,:,:) +! output: zeta(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -627,22 +625,22 @@ subroutine compute_div_C0_hybrid(zeta,elem,hybrid,nets,nete,nt) subroutine neighbor_minmax(hybrid,edgeMinMax,nets,nete,min_neigh,max_neigh) - + type (hybrid_t) , intent(in) :: hybrid type (EdgeBuffer_t) , intent(inout) :: edgeMinMax integer :: nets,nete real (kind=r8) :: min_neigh(nlev,qsize,nets:nete) real (kind=r8) :: max_neigh(nlev,qsize,nets:nete) integer :: kblk, qblk - ! local + ! local integer:: ie, q, k, kptr integer:: kbeg, kend, qbeg, qend call get_loop_ranges(hybrid,kbeg=kbeg,kend=kend,qbeg=qbeg,qend=qend) - + kblk = kend - kbeg + 1 ! calculate size of the block of vertical levels qblk = qend - qbeg + 1 ! calculate size of the block of tracers - + do ie=nets,nete do q = qbeg, qend kptr = nlev*(q - 1) + kbeg - 1 @@ -651,7 +649,7 @@ subroutine neighbor_minmax(hybrid,edgeMinMax,nets,nete,min_neigh,max_neigh) call edgeSpack(edgeMinMax,max_neigh(kbeg:kend,q,ie),kblk,kptr,ie) enddo enddo - + call bndry_exchange(hybrid,edgeMinMax,location='neighbor_minmax') do ie=nets,nete @@ -667,7 +665,7 @@ subroutine neighbor_minmax(hybrid,edgeMinMax,nets,nete,min_neigh,max_neigh) enddo end subroutine neighbor_minmax - + subroutine neighbor_minmax_start(hybrid,edgeMinMax,nets,nete,min_neigh,max_neigh) @@ -679,7 +677,7 @@ subroutine neighbor_minmax_start(hybrid,edgeMinMax,nets,nete,min_neigh,max_neigh integer :: kblk, qblk integer :: kbeg, kend, qbeg, qend - ! local + ! local integer :: ie,q, k,kptr call get_loop_ranges(hybrid,kbeg=kbeg,kend=kend,qbeg=qbeg,qend=qend) 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..586ee06b1f 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -46,6 +46,9 @@ module dyn_comp use edge_mod, only: initEdgeBuffer, edgeVpack, edgeVunpack, FreeEdgeBuffer use edgetype_mod, only: EdgeBuffer_t use bndry_mod, only: bndry_exchange +use se_single_column_mod, only: scm_setinitial +use scamMod, only: single_column, readiopdata, use_iop, setiopupdate_init +use hycoef, only: hyai, hybi, ps0 implicit none private @@ -110,7 +113,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 +171,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 +216,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 +291,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 +359,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 +475,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 +621,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 @@ -745,8 +750,13 @@ subroutine dyn_init(dyn_in, dyn_out) call set_phis(dyn_in) if (initial_run) then - call read_inidat(dyn_in) - call clean_iodesc_list() + call read_inidat(dyn_in) + if (use_iop .and. masterproc) then + call setiopupdate_init() + call readiopdata( hvcoord%hyam, hvcoord%hybm, hvcoord%hyai, hvcoord%hybi, hvcoord%ps0 ) + call scm_setinitial(dyn_in%elem) + end if + call clean_iodesc_list() end if ! ! initialize diffusion in dycore @@ -799,28 +809,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 +937,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 +994,12 @@ 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 + use scamMod, only: single_column, use_3dfrc + use se_single_column_mod, only: apply_SC_forcing,ie_scm type(dyn_export_t), intent(inout) :: dyn_state @@ -986,6 +1018,7 @@ subroutine dyn_run(dyn_state) real(r8), allocatable, dimension(:,:,:) :: ps_before real(r8), allocatable, dimension(:,:,:) :: abs_ps_tend real (kind=r8) :: omega_cn(2,nelemd) !min and max of vertical Courant number + integer :: nets_in,nete_in !---------------------------------------------------------------------------- #ifdef debug_coupling @@ -997,6 +1030,7 @@ subroutine dyn_run(dyn_state) if (iam >= par%nprocs) return + if (.not. use_3dfrc ) then ldiag = hist_fld_active('ABS_dPSdt') if (ldiag) then allocate(ps_before(np,np,nelemd)) @@ -1042,24 +1076,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 +1109,6 @@ subroutine dyn_run(dyn_state) end do end if - if (use_cslam) then do ie = nets, nete do m = 1, ntrac @@ -1105,8 +1137,15 @@ subroutine dyn_run(dyn_state) end if ! forward-in-time RK, with subcycling - call prim_run_subcycle(dyn_state%elem, dyn_state%fvm, hybrid, nets, nete, & - tstep, TimeLevel, hvcoord, n, omega_cn) + if (single_column) then + nets_in=ie_scm + nete_in=ie_scm + else + nets_in=nets + nete_in=nete + end if + call prim_run_subcycle(dyn_state%elem, dyn_state%fvm, hybrid, nets_in, nete_in, & + tstep, TimeLevel, hvcoord, n, single_column, omega_cn) if (ldiag) then do ie = nets, nete @@ -1130,6 +1169,13 @@ subroutine dyn_run(dyn_state) if (ldiag) then deallocate(ps_before,abs_ps_tend) endif + + end if ! not use_3dfrc + + if (single_column) then + call apply_SC_forcing(dyn_state%elem,hvcoord,TimeLevel,3,.false.) + end if + ! output vars on CSLAM fvm grid call write_dyn_vars(dyn_state) @@ -1333,8 +1379,9 @@ subroutine read_inidat(dyn_in) allocate(dbuf3(npsq,nlev,nelemd)) ! Check that columns in IC file match grid definition. - call check_file_layout(fh_ini, elem, dyn_cols, 'ncdata', .true.) - + if (.not. single_column) then + call check_file_layout(fh_ini, elem, dyn_cols, 'ncdata', .true.) + end if ! Read 2-D field fieldname = 'PS' @@ -1795,6 +1842,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 +1876,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,10 +1901,14 @@ 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 - grid_name = 'GLL' + if (single_column) then + grid_name = 'SCM' else - grid_name = 'physgrid_d' + if (fv_nphys == 0) then + grid_name = 'GLL' + else + grid_name = 'physgrid_d' + end if end if ! Get number of global columns from the grid object and check that @@ -1870,7 +1922,7 @@ subroutine set_phis(dyn_in) call endrun(sub//': dimension ncol not found in bnd_topo file') end if ierr = pio_inq_dimlen(fh_topo, ncol_did, ncol_size) - if (ncol_size /= dyn_cols) then + if (ncol_size /= dyn_cols .and. .not. single_column) then if (masterproc) then write(iulog,*) sub//': ncol_size=', ncol_size, ' : dyn_cols=', dyn_cols end if @@ -1878,13 +1930,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 +1993,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 +2008,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..69d9bbc520 100644 --- a/src/dynamics/se/dyn_grid.F90 +++ b/src/dynamics/se/dyn_grid.F90 @@ -59,6 +59,7 @@ module dyn_grid integer, parameter :: fvm_decomp = 102 ! The FVM (CSLAM) grid integer, parameter :: physgrid_d = 103 ! physics grid on dynamics decomp integer, parameter :: ini_decomp = 104 ! alternate dynamics grid for reading initial file +integer, parameter :: ini_decomp_scm = 205 ! alternate dynamics grid for reading initial file character(len=3), protected :: ini_grid_name ! Name of horizontal grid dimension in initial file. @@ -177,12 +178,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 @@ -732,8 +733,8 @@ subroutine define_cam_grids() use cam_grid_support, only: horiz_coord_t, horiz_coord_create use cam_grid_support, only: cam_grid_register, cam_grid_attribute_register use dimensions_mod, only: nc - use shr_const_mod, only: PI => SHR_CONST_PI - + use shr_const_mod, only: PI => SHR_CONST_PI + use scamMod, only: closeioplon,closeioplat,closeioplonidx,single_column ! Local variables integer :: i, ii, j, k, ie, mapind character(len=8) :: latname, lonname, ncolname, areaname @@ -741,6 +742,7 @@ subroutine define_cam_grids() type(horiz_coord_t), pointer :: lat_coord type(horiz_coord_t), pointer :: lon_coord integer(iMap), pointer :: grid_map(:,:) + integer(iMap), pointer :: grid_map_scm(:,:) !grid_map decomp for single column mode real(r8), allocatable :: pelat_deg(:) ! pe-local latitudes (degrees) real(r8), allocatable :: pelon_deg(:) ! pe-local longitudes (degrees) @@ -748,6 +750,8 @@ subroutine define_cam_grids() real(r8), pointer :: pearea_wt(:) ! pe-local areas normalized for unit sphere integer(iMap) :: fdofP_local(npsq,nelemd) ! pe-local map for dynamics decomp integer(iMap), allocatable :: pemap(:) ! pe-local map for PIO decomp + integer(iMap), allocatable :: pemap_scm(:) ! pe-local map for single column PIO decomp + real(r8) :: latval(1),lonval(1) integer :: ncols_fvm, ngcols_fvm real(r8), allocatable :: fvm_coord(:) @@ -859,7 +863,6 @@ subroutine define_cam_grids() ! If dim name is 'ncol', create INI grid ! We will read from INI grid, but use GLL grid for all output if (trim(ini_grid_hdim_name) == 'ncol') then - lat_coord => horiz_coord_create('lat', 'ncol', ngcols_d, & 'latitude', 'degrees_north', 1, size(pelat_deg), pelat_deg, map=pemap) lon_coord => horiz_coord_create('lon', 'ncol', ngcols_d, & @@ -894,6 +897,42 @@ subroutine define_cam_grids() ! to it. It can be nullified. nullify(grid_map) + !--------------------------------- + ! Create SCM grid object when running single column mode + !--------------------------------- + + if ( single_column) then + allocate(pemap_scm(1)) + pemap_scm = 0_iMap + pemap_scm = closeioplonidx + + ! Map for scm grid + allocate(grid_map_scm(3,npsq)) + grid_map_scm = 0_iMap + mapind = 1 + j = 1 + do i = 1, npsq + grid_map_scm(1, mapind) = i + grid_map_scm(2, mapind) = j + grid_map_scm(3, mapind) = pemap_scm(1) + mapind = mapind + 1 + end do + latval=closeioplat + lonval=closeioplon + + lat_coord => horiz_coord_create('lat', 'ncol', 1, & + 'latitude', 'degrees_north', 1, 1, latval, map=pemap_scm) + lon_coord => horiz_coord_create('lon', 'ncol', 1, & + 'longitude', 'degrees_east', 1, 1, lonval, map=pemap_scm) + + call cam_grid_register('SCM', ini_decomp_scm, lat_coord, lon_coord, & + grid_map_scm, block_indexed=.false., unstruct=.true.) + deallocate(pemap_scm) + ! grid_map cannot be deallocated as the cam_filemap_t object just points + ! to it. It can be nullified. + nullify(grid_map_scm) + end if + !--------------------------------- ! Create FVM grid object for CSLAM !--------------------------------- diff --git a/src/dynamics/se/gravity_waves_sources.F90 b/src/dynamics/se/gravity_waves_sources.F90 index 9adffc001b..a929dfeaf1 100644 --- a/src/dynamics/se/gravity_waves_sources.F90 +++ b/src/dynamics/se/gravity_waves_sources.F90 @@ -74,7 +74,7 @@ subroutine gws_src_fnct(elem, tl, tlq, frontgf, frontga,nphys) call get_loop_ranges(hybrid,ibeg=nets,iend=nete) allocate(frontgf_thr(nphys,nphys,nlev,nets:nete)) - allocate(frontga_thr(nphys,nphys,nlev,nets:nete)) + allocate(frontga_thr(nphys,nphys,nlev,nets:nete)) call compute_frontogenesis(frontgf_thr,frontga_thr,tl,tlq,elem,deriv,hybrid,nets,nete,nphys) if (fv_nphys>0) then do ie=nets,nete @@ -111,14 +111,14 @@ subroutine compute_frontogenesis(frontgf,frontga,tl,tlq,elem,ederiv,hybrid,nets, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! use physconst, only: cappa use air_composition,only: dry_air_species_num, thermodynamic_active_species_num - use air_composition,only: thermodynamic_active_species_idx_dycore + use air_composition,only: thermodynamic_active_species_idx_dycore use derivative_mod, only: gradient_sphere, ugradv_sphere use edge_mod, only: edgevpack, edgevunpack use bndry_mod, only: bndry_exchange use dyn_grid, only: hvcoord use dimensions_mod, only: fv_nphys,ntrac use fvm_mapping, only: dyn2phys_vector,dyn2phys - + type(hybrid_t), intent(in) :: hybrid type(element_t), intent(inout), target :: elem(:) type(derivative_t), intent(in) :: ederiv @@ -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 @@ -157,16 +157,16 @@ subroutine compute_frontogenesis(frontgf,frontga,tl,tlq,elem,ederiv,hybrid,nets, pint(:,:) = pint(:,:)+elem(ie)%state%dp3d(:,:,k,tl) ! theta(:,:) = elem(ie)%state%T(:,:,k,tl)*(psurf_ref / p(:,:))**cappa - ! gradth(:,:,:,k,ie) = gradient_sphere(theta,ederiv,elem(ie)%Dinv) - call gradient_sphere(theta,ederiv,elem(ie)%Dinv,gradth(:,:,:,k,ie)) + ! gradth(:,:,:,k,ie) = gradient_sphere(theta,ederiv,elem(ie)%Dinv) + call gradient_sphere(theta,ederiv,elem(ie)%Dinv,gradth(:,:,:,k,ie)) ! compute C = (grad(theta) dot grad ) u - C(:,:,:) = ugradv_sphere(gradth(:,:,:,k,ie), elem(ie)%state%v(:,:,:,k,tl),ederiv,elem(ie)) + C(:,:,:) = ugradv_sphere(gradth(:,:,:,k,ie), elem(ie)%state%v(:,:,:,k,tl),ederiv,elem(ie)) ! gradth dot C - frontgf_gll(:,:,k,ie) = -( C(:,:,1)*gradth(:,:,1,k,ie) + C(:,:,2)*gradth(:,:,2,k,ie) ) + frontgf_gll(:,:,k,ie) = -( C(:,:,1)*gradth(:,:,1,k,ie) + C(:,:,2)*gradth(:,:,2,k,ie) ) ! apply mass matrix gradth(:,:,1,k,ie)=gradth(:,:,1,k,ie)*elem(ie)%spheremp(:,:) gradth(:,:,2,k,ie)=gradth(:,:,2,k,ie)*elem(ie)%spheremp(:,:) - frontgf_gll(:,:,k,ie)=frontgf_gll(:,:,k,ie)*elem(ie)%spheremp(:,:) + frontgf_gll(:,:,k,ie)=frontgf_gll(:,:,k,ie)*elem(ie)%spheremp(:,:) enddo ! pack call edgeVpack(edge3, frontgf_gll(:,:,:,ie),nlev,0,ie) @@ -180,7 +180,7 @@ subroutine compute_frontogenesis(frontgf,frontga,tl,tlq,elem,ederiv,hybrid,nets, do k=1,nlev gradth(:,:,1,k,ie)=gradth(:,:,1,k,ie)*elem(ie)%rspheremp(:,:) gradth(:,:,2,k,ie)=gradth(:,:,2,k,ie)*elem(ie)%rspheremp(:,:) - frontgf_gll(:,:,k,ie)=frontgf_gll(:,:,k,ie)*elem(ie)%rspheremp(:,:) + frontgf_gll(:,:,k,ie)=frontgf_gll(:,:,k,ie)*elem(ie)%rspheremp(:,:) end do if (fv_nphys>0) then uv_tmp(:,:,:) = dyn2phys_vector(gradth(:,:,:,:,ie),elem(ie)) @@ -201,7 +201,7 @@ subroutine compute_frontogenesis(frontgf,frontga,tl,tlq,elem,ederiv,hybrid,nets, area_inv = 1.0_r8/area_inv do k=1,nlev frontgf(:,:,k,ie) = dyn2phys(frontgf_gll(:,:,k,ie),elem(ie)%metdet,area_inv) - end do + end do else do k=1,nlev frontgf(:,:,k,ie)=frontgf_gll(:,:,k,ie) diff --git a/src/dynamics/se/se_single_column_mod.F90 b/src/dynamics/se/se_single_column_mod.F90 new file mode 100644 index 0000000000..1653b2e43e --- /dev/null +++ b/src/dynamics/se/se_single_column_mod.F90 @@ -0,0 +1,373 @@ +module se_single_column_mod +!-------------------------------------------------------- +! +! Module for the SE single column model + +use shr_kind_mod, only: r8=>shr_kind_r8 +use element_mod, only: element_t +use scamMod, only: have_t, have_q, have_u, have_v, have_ps, have_numliq, & + have_cldliq, have_numice, have_cldice, have_omega, use_camiop, & + tobs, qobs,have_numliq, numliqobs, cldliqobs, numiceobs, cldiceobs, & + wfld, psobs,uobs,vobs,tobs,divt,divQ,divT3d,divq3d,precobs,lhflxobs, & + shflxobs, tground, have_ps, have_tg, have_lhflx, have_shflx, have_t, & + have_omega, have_cldliq, have_divt, have_divq, have_divt3d, have_divq3d, & + use_3dfrc,scmlat,scmlon +use constituents, only: cnst_get_ind, pcnst +use dimensions_mod, only: nelemd, np, nlev, qsize +use time_manager, only: get_nstep, is_first_step, get_step_size, is_first_restart_step +use ppgrid, only: begchunk +use se_dyn_time_mod, only: timelevel_qdp +use cam_history, only: outfld + +implicit none + +private +save + +public scm_setinitial +public scm_setfield +public apply_SC_forcing +public iop_broadcast +public scm_dyn_grid_indicies + +integer, public :: indx_scm, ie_scm, i_scm, j_scm + +integer :: tl_f, tl_fqdp, thelev + +!========================================================================= +contains +!========================================================================= + +subroutine scm_setinitial(elem) + + use dyn_grid, only: TimeLevel + use control_mod, only: qsplit + + implicit none + + type(element_t), intent(inout) :: elem(:) + + integer :: k + integer :: inumliq, inumice, icldliq, icldice + + call scm_dyn_grid_indicies(elem,scmlat,scmlon,ie_scm,i_scm,j_scm,indx_scm) + + tl_f = timelevel%n0 + call TimeLevel_Qdp(timelevel, qsplit, tl_fqdp) + + if (.not. use_camiop .and. get_nstep() == 0) then + call cnst_get_ind('NUMLIQ', inumliq, abort=.false.) + call cnst_get_ind('NUMICE', inumice, abort=.false.) + call cnst_get_ind('CLDLIQ', icldliq) + call cnst_get_ind('CLDICE', icldice) + + ! Find level where tobs is no longer zero + thelev=minloc(abs(tobs), 1, mask=abs(tobs) > 0) + + if (get_nstep() <= 1) then + do k=1,thelev-1 + tobs(k)=elem(ie_scm)%state%T(i_scm,j_scm,k,tl_f) + qobs(k)=elem(ie_scm)%state%qdp(i_scm,j_scm,k,1,tl_fqdp)/elem(ie_scm)%state%dp3d(i_scm,j_scm,k,tl_f) + enddo + else + tobs(:)=elem(ie_scm)%state%T(i_scm,j_scm,:,tl_f) + qobs(:)=elem(ie_scm)%state%qdp(i_scm,j_scm,:,1,tl_fqdp)/elem(ie_scm)%state%dp3d(i_scm,j_scm,:,tl_f) + endif + + if (get_nstep() == 0) then + do k=thelev, NLEV + if (have_t) elem(ie_scm)%state%T(i_scm,j_scm,k,tl_f)=tobs(k) + if (have_q) elem(ie_scm)%state%qdp(i_scm,j_scm,k,1,tl_fqdp)=qobs(k)*elem(ie_scm)%state%dp3d(i_scm,j_scm,k,tl_f) + enddo + + do k=1,NLEV + if (have_ps) elem(ie_scm)%state%psdry(i_scm,j_scm) = psobs + if (have_u) elem(ie_scm)%state%v(i_scm,j_scm,1,k,tl_f) = uobs(k) + if (have_v) elem(ie_scm)%state%v(i_scm,j_scm,2,k,tl_f) = vobs(k) + if (have_numliq) elem(ie_scm)%state%qdp(i_scm,j_scm,k,inumliq,tl_fqdp) = & + numliqobs(k)*elem(ie_scm)%state%dp3d(i_scm,j_scm,k,tl_f) + if (have_cldliq) elem(ie_scm)%state%qdp(i_scm,j_scm,k,icldliq,tl_fqdp) = & + cldliqobs(k)*elem(ie_scm)%state%dp3d(i_scm,j_scm,k,tl_f) + if (have_numice) elem(ie_scm)%state%qdp(i_scm,j_scm,k,inumice,tl_fqdp) = & + numiceobs(k)*elem(ie_scm)%state%dp3d(i_scm,j_scm,k,tl_f) + if (have_cldice) elem(ie_scm)%state%qdp(i_scm,j_scm,k,icldice,tl_fqdp) = & + cldiceobs(k)*elem(ie_scm)%state%dp3d(i_scm,j_scm,k,tl_f) + if (have_omega) elem(ie_scm)%derived%omega(i_scm,j_scm,k) = wfld(k) + enddo + + endif + + endif + +end subroutine scm_setinitial + +subroutine scm_setfield(elem,iop_update_phase1) + +!--------------------------------------------------------- +! Purpose: Update various fields based on available data +! provided by IOP file +!---------------------------------------------------------- + + use control_mod, only: qsplit + use dyn_grid, only: TimeLevel + + implicit none + + logical, intent(in) :: iop_update_phase1 + type(element_t), intent(inout) :: elem(:) + + integer :: k + integer :: tl_f, tl_fqdp + + tl_f = timelevel%n0 + call TimeLevel_Qdp(timelevel, qsplit, tl_fqdp) + + if (have_ps .and. use_camiop .and. .not. iop_update_phase1) elem(ie_scm)%state%psdry(:,:) = psobs + if (have_ps .and. .not. use_camiop) elem(ie_scm)%state%psdry(:,:) = psobs + do k=1, NLEV + if (have_omega .and. iop_update_phase1) elem(ie_scm)%derived%omega(:,:,k)=wfld(k) ! set t to tobs at first + if (k < thelev) then + tobs(k) = elem(ie_scm)%state%T(i_scm,j_scm,k,tl_f) + qobs(k) = elem(ie_scm)%state%qdp(i_scm,j_scm,k,1,tl_fqdp)/elem(ie_scm)%state%dp3d(i_scm,j_scm,k,tl_f) + uobs(k) = elem(ie_scm)%state%v(i_scm,j_scm,1,k,tl_f) + vobs(k) = elem(ie_scm)%state%v(i_scm,j_scm,2,k,tl_f) + end if + end do + +end subroutine scm_setfield + +subroutine apply_SC_forcing(elem,hvcoord,tl,n,t_before_advance) +! + use scamMod, only: single_column, use_3dfrc + use hybvcoord_mod, only: hvcoord_t + use se_dyn_time_mod,only: TimeLevel_t + use control_mod, only: qsplit + use apply_iop_forcing_mod, only:advance_iop_forcing, advance_iop_nudging + + type (element_t), intent(inout), target :: elem(:) + type (hvcoord_t), intent(in) :: hvcoord + type (TimeLevel_t), intent(in) :: tl + logical, intent(in) :: t_before_advance + integer, intent(in) :: n + + integer :: k, m + real (r8) :: dt + logical :: iop_nudge_tq = .false. + real (r8), dimension(nlev,pcnst) :: stateQ_in, q_update, q_phys_frc + real (r8), dimension(nlev) :: t_phys_frc, t_update, u_update, v_update + real (r8), dimension(nlev) :: t_in, u_in, v_in + real (r8), dimension(nlev) :: relaxt, relaxq + real (r8), dimension(nlev) :: tdiff_dyn, qdiff_dyn + +!----------------------------------------------------------------------- + + tl_f = tl%n0 + + call TimeLevel_Qdp(tl, qsplit, tl_fqdp) + + dt = get_step_size() + + ! Set initial profiles for current column + do m=1,pcnst + stateQ_in(:nlev,m) = elem(ie_scm)%state%Qdp(i_scm,j_scm,:nlev,m,tl_fqdp)/elem(ie_scm)%state%dp3d(i_scm,j_scm,:nlev,tl_f) + end do + t_in(:nlev) = elem(ie_scm)%state%T(i_scm,j_scm,:nlev,tl_f) + u_in(:nlev) = elem(ie_scm)%state%v(i_scm,j_scm,1,:nlev,tl_f) + v_in(:nlev) = elem(ie_scm)%state%v(i_scm,j_scm,2,:nlev,tl_f) + + t_phys_frc(:) = elem(ie_scm)%derived%fT(i_scm,j_scm,:) + q_phys_frc(:,:qsize) = elem(ie_scm)%derived%fQ(i_scm,j_scm,:,:qsize)/dt + + ! Call the main subroutine to update t, q, u, and v according to + ! large scale forcing as specified in IOP file. + call advance_iop_forcing(dt,elem(ie_scm)%state%psdry(i_scm,j_scm),& ! In + u_in,v_in,t_in,stateQ_in,t_phys_frc, q_phys_frc, hvcoord, & ! In + u_update,v_update,t_update,q_update) ! Out + + ! Nudge to observations if desired, for T & Q only if in SCM mode + if (iop_nudge_tq ) then + call advance_iop_nudging(dt,elem(ie_scm)%state%psdry(i_scm,j_scm),& ! In + t_update,q_update,u_update,v_update, hvcoord, & ! Inout + relaxt,relaxq) ! Out + endif + + if (use_3dfrc) then ! vertical remap of dynamics not run need to update state%dp3d using new psdry + do k=1,nlev + elem(ie_scm)%state%dp3d(i_scm,j_scm,k,tl_f) = (hvcoord%hyai(k+1)-hvcoord%hyai(k))*hvcoord%ps0 + & + (hvcoord%hybi(k+1)-hvcoord%hybi(k))*elem(ie_scm)%state%psdry(i_scm,j_scm) + end do + end if + + ! Update qdp using new dp3d + do m=1,pcnst + ! Update the Qdp array + elem(ie_scm)%state%Qdp(i_scm,j_scm,:nlev,m,tl_fqdp) = & + q_update(:nlev,m) * elem(ie_scm)%state%dp3d(i_scm,j_scm,:nlev,tl_f) + enddo + + ! Update prognostic variables to the current values + elem(ie_scm)%state%T(i_scm,j_scm,:,tl_f) = t_update(:) + elem(ie_scm)%state%v(i_scm,j_scm,1,:,tl_f) = u_update(:) + elem(ie_scm)%state%v(i_scm,j_scm,2,:,tl_f) = v_update(:) + + ! Evaluate the differences in state information from observed + ! (done for diganostic purposes only) + do k = 1, nlev + tdiff_dyn(k) = t_update(k) - tobs(k) + qdiff_dyn(k) = q_update(k,1) - qobs(k) + end do + + ! Add various diganostic outfld calls + call outfld('TDIFF',tdiff_dyn,1,begchunk) + call outfld('QDIFF',qdiff_dyn,1,begchunk) + call outfld('TOBS',tobs,1,begchunk) + call outfld('QOBS',qobs,1,begchunk) + call outfld('DIVQ',divq,1,begchunk) + call outfld('DIVT',divt,1,begchunk) + call outfld('DIVQ3D',divq3d,1,begchunk) + call outfld('DIVT3D',divt3d,1,begchunk) + call outfld('PRECOBS',precobs,1,begchunk) + call outfld('LHFLXOBS',lhflxobs,1,begchunk) + call outfld('SHFLXOBS',shflxobs,1,begchunk) + + call outfld('TRELAX',relaxt,1,begchunk) + call outfld('QRELAX',relaxq,1,begchunk) + + + end subroutine apply_SC_forcing +!========================================================================= + subroutine iop_broadcast() + + !--------------------------------------------------------- + ! Purpose: Broadcast relevant logical + ! flags and data to all processors + !---------------------------------------------------------- + + use spmd_utils, only: mpi_logical, mpi_real8, masterproc, iam, mpicom, mstrid=>masterprocid + use cam_abortutils, only: endrun + + integer :: ierr + character(len=*), parameter :: sub = 'radiation_readnl' + +#ifdef SPMD + call mpi_bcast(have_ps,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_ps") + call mpi_bcast(have_tg,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_tg") + call mpi_bcast(have_lhflx,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_lhflx") + call mpi_bcast(have_shflx,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_shflx") + call mpi_bcast(have_t,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_t") + call mpi_bcast(have_q,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_q") + call mpi_bcast(have_u,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_u") + call mpi_bcast(have_v,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_v") + call mpi_bcast(have_omega,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_omega") + call mpi_bcast(have_cldliq,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_cldliq") + call mpi_bcast(have_divt,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_divt") + call mpi_bcast(have_divq,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_divq") + call mpi_bcast(have_divt3d,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_divt3d") + call mpi_bcast(have_divq3d,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: have_divq3d") + call mpi_bcast(use_3dfrc,1,mpi_logical,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: use_3dfrc") + + call mpi_bcast(psobs,1,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: psobs") + call mpi_bcast(tground,1,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: tground") + call mpi_bcast(lhflxobs,1,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: lhflxobs") + call mpi_bcast(shflxobs,1,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: shflxobs") + + call mpi_bcast(tobs,nlev,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: tobs") + call mpi_bcast(qobs,nlev,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: qobs") + call mpi_bcast(uobs,nlev,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: uobs") + call mpi_bcast(vobs,nlev,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: vobs") + call mpi_bcast(cldliqobs,nlev,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: cldliqobs") + call mpi_bcast(wfld,nlev,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: wfld") + + call mpi_bcast(divt,nlev,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: divt") + call mpi_bcast(divq,nlev,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: divq") + call mpi_bcast(divt3d,nlev,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: divt3d") + call mpi_bcast(divq3d,nlev,mpi_real8,mstrid,mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: divq3d") + +#endif + + end subroutine iop_broadcast + +!========================================================================= + subroutine scm_dyn_grid_indicies(elem,scmlat,scmlon,ie_scm,i_scm,j_scm,indx_scm) + + !--------------------------------------------------------- + ! Purpose: Determine closest column index in the IOP file + ! based on the input scm latitude and longitude + !---------------------------------------------------------- + + use shr_const_mod, only: SHR_CONST_PI + use cam_abortutils, only: endrun + + type(element_t), intent(in) :: elem(:) + real (r8), intent(in) :: scmlat,scmlon + integer, intent(out) :: ie_scm, j_scm, i_scm, indx_scm + + integer :: i, j, indx, ie + real(r8) :: scmposlon, minpoint, testlat, testlon, testval + integer :: ierr + real(r8), parameter :: rad2deg = 180.0_r8 / SHR_CONST_PI + character(len=*), parameter :: sub = 'scm_dyn_grid_indicies' + + ie_scm=0 + i_scm=0 + j_scm=0 + indx_scm=0 + minpoint = 1000 + scmposlon = mod(scmlon + 360._r8,360._r8) + do ie=1, nelemd + indx=1 + do j=1, np + do i=1, np + testlat=elem(ie)%spherep(i,j)%lat * rad2deg + testlon=elem(ie)%spherep(i,j)%lon * rad2deg + if (testlon < 0._r8) testlon=testlon+360._r8 + testval=abs(scmlat-testlat)+abs(scmposlon-testlon) + if (testval < minpoint) then + ie_scm=ie + indx_scm=indx + i_scm=i + j_scm=j + minpoint=testval + if (minpoint < 1.e-7_r8) minpoint=0._r8 + endif + indx=indx+1 + enddo + enddo + enddo + + if (ie_scm == 0 .or. i_scm == 0 .or. j_scm == 0 .or. indx_scm == 0) then + call endrun(sub//':FATAL: Could not find closest SCM point on input datafile') + endif + + end subroutine scm_dyn_grid_indicies + + end module se_single_column_mod diff --git a/src/dynamics/se/stepon.F90 b/src/dynamics/se/stepon.F90 index 82f6ec03e2..2d49a434cc 100644 --- a/src/dynamics/se/stepon.F90 +++ b/src/dynamics/se/stepon.F90 @@ -1,7 +1,7 @@ module stepon use shr_kind_mod, only: r8 => shr_kind_r8 -use spmd_utils, only: iam, mpicom +use spmd_utils, only: iam, mpicom, masterproc use ppgrid, only: begchunk, endchunk use physics_types, only: physics_state, physics_tend @@ -11,11 +11,18 @@ module stepon use cam_abortutils, only: endrun use parallel_mod, only: par -use dimensions_mod, only: nelemd +use dimensions_mod, only: np, npsq, nlev, nelemd use aerosol_properties_mod, only: aerosol_properties use aerosol_state_mod, only: aerosol_state use microp_aero, only: aerosol_state_object, aerosol_properties_object +use scamMod, only: use_iop, doiopupdate, single_column, & + setiopupdate, readiopdata +use se_single_column_mod, only: scm_setfield, iop_broadcast +use dyn_grid, only: hvcoord +use time_manager, only: get_step_size, is_first_restart_step +use cam_history, only: outfld, write_camiop, addfld, add_default, horiz_only +use cam_history, only: write_inithist, hist_fld_active, fieldname_len implicit none private @@ -29,6 +36,7 @@ module stepon class(aerosol_properties), pointer :: aero_props_obj => null() logical :: aerosols_transported = .false. +logical :: iop_update_phase1 !========================================================================================= contains @@ -36,7 +44,6 @@ module stepon subroutine stepon_init(dyn_in, dyn_out ) - use cam_history, only: addfld, add_default, horiz_only use constituents, only: pcnst, cnst_name, cnst_longname use dimensions_mod, only: fv_nphys, cnst_name_gll, cnst_longname_gll, qsize @@ -95,7 +102,6 @@ end subroutine stepon_init subroutine stepon_run1( dtime_out, phys_state, phys_tend, & pbuf2d, dyn_in, dyn_out ) - use time_manager, only: get_step_size use dp_coupling, only: d_p_coupling use physics_buffer, only: physics_buffer_desc @@ -123,6 +129,31 @@ subroutine stepon_run1( dtime_out, phys_state, phys_tend, & call diag_dynvar_ic(dyn_out%elem, dyn_out%fvm) end if + ! Determine whether it is time for an IOP update; + ! doiopupdate set to true if model time step > next available IOP + + + if (use_iop .and. masterproc) then + call setiopupdate + end if + + if (single_column) then + + ! If first restart step then ensure that IOP data is read + if (is_first_restart_step()) then + if (masterproc) call readiopdata( hvcoord%hyam, hvcoord%hybm, hvcoord%hyai, hvcoord%hybi, hvcoord%ps0 ) + call iop_broadcast() + endif + + iop_update_phase1 = .true. + if ((is_first_restart_step() .or. doiopupdate) .and. masterproc) then + call readiopdata( hvcoord%hyam, hvcoord%hybm, hvcoord%hyai, hvcoord%hybi, hvcoord%ps0 ) + endif + call iop_broadcast() + + call scm_setfield(dyn_out%elem,iop_update_phase1) + endif + call t_barrierf('sync_d_p_coupling', mpicom) call t_startf('d_p_coupling') ! Move data into phys_state structure. @@ -205,10 +236,12 @@ subroutine stepon_run3(dtime, cam_out, phys_state, dyn_in, dyn_out) use camsrfexch, only: cam_out_t use dyn_comp, only: dyn_run - use advect_tend, only: compute_adv_tends_xyz + use advect_tend, only: compute_adv_tends_xyz, compute_write_iop_fields use dyn_grid, only: TimeLevel use se_dyn_time_mod,only: TimeLevel_Qdp use control_mod, only: qsplit + use constituents, only: pcnst, cnst_name + ! arguments real(r8), intent(in) :: dtime ! Time-step type(cam_out_t), intent(inout) :: cam_out(:) ! Output from CAM to surface @@ -219,10 +252,21 @@ subroutine stepon_run3(dtime, cam_out, phys_state, dyn_in, dyn_out) integer :: tl_f, tl_fQdp !-------------------------------------------------------------------------------------- + if (single_column) then + ! Update IOP properties e.g. omega, divT, divQ + iop_update_phase1 = .false. + if (doiopupdate) then + if (masterproc) call readiopdata( hvcoord%hyam, hvcoord%hybm, hvcoord%hyai, hvcoord%hybi, hvcoord%ps0 ) + call iop_broadcast() + call scm_setfield(dyn_out%elem,iop_update_phase1) + endif + endif + call t_startf('comp_adv_tends1') tl_f = TimeLevel%n0 call TimeLevel_Qdp(TimeLevel, qsplit, tl_fQdp) call compute_adv_tends_xyz(dyn_in%elem,dyn_in%fvm,1,nelemd,tl_fQdp,tl_f) + if (write_camiop) call compute_write_iop_fields(dyn_in%elem,dyn_in%fvm,1,nelemd,tl_fQdp,tl_f) call t_stopf('comp_adv_tends1') call t_barrierf('sync_dyn_run', mpicom) @@ -234,6 +278,7 @@ subroutine stepon_run3(dtime, cam_out, phys_state, dyn_in, dyn_out) tl_f = TimeLevel%n0 call TimeLevel_Qdp(TimeLevel, qsplit, tl_fQdp) call compute_adv_tends_xyz(dyn_in%elem,dyn_in%fvm,1,nelemd,tl_fQdp,tl_f) + if (write_camiop) call compute_write_iop_fields(dyn_in%elem,dyn_in%fvm,1,nelemd,tl_fQdp,tl_f) call t_stopf('comp_adv_tends2') end subroutine stepon_run3 @@ -251,7 +296,6 @@ end subroutine stepon_final subroutine diag_dynvar_ic(elem, fvm) use constituents, only: cnst_type - use cam_history, only: write_inithist, outfld, hist_fld_active, fieldname_len use dyn_grid, only: TimeLevel use se_dyn_time_mod, only: TimeLevel_Qdp ! dynamics typestep 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/infrastructure/phys_grid.F90 b/src/infrastructure/phys_grid.F90 index 3426c86f27..8da2f0b461 100644 --- a/src/infrastructure/phys_grid.F90 +++ b/src/infrastructure/phys_grid.F90 @@ -21,7 +21,7 @@ module phys_grid ! !------------------------------------------------------------------------------ use shr_kind_mod, only: r8 => shr_kind_r8 - use ppgrid, only: begchunk, endchunk + use ppgrid, only: begchunk, endchunk, pver, pverp, pcols use physics_column_type, only: physics_column_t use perf_mod, only: t_adj_detailf, t_startf, t_stopf @@ -63,6 +63,7 @@ module phys_grid ! The identifier for the physics grid integer, parameter, public :: phys_decomp = 100 + integer, parameter, public :: phys_decomp_scm = 200 !! PUBLIC TYPES @@ -110,15 +111,13 @@ module phys_grid end interface get_lon_all_p !!XXgoldyXX: ^ temporary interface to allow old code to compile - - integer, protected, public :: pver = 0 - integer, protected, public :: pverp = 0 integer, protected, public :: num_global_phys_cols = 0 integer, protected, public :: columns_on_task = 0 integer, protected, public :: index_top_layer = 0 integer, protected, public :: index_bottom_layer = 0 integer, protected, public :: index_top_interface = 1 integer, protected, public :: index_bottom_interface = 0 + integer, public :: phys_columns_on_task = 0 !============================================================================== CONTAINS @@ -130,7 +129,6 @@ subroutine phys_grid_readnl(nlfile) use cam_logfile, only: iulog use spmd_utils, only: mpicom, mstrid=>masterprocid, masterproc use spmd_utils, only: mpi_integer - use ppgrid, only: pcols character(len=*), intent(in) :: nlfile @@ -184,13 +182,13 @@ subroutine phys_grid_init() use cam_abortutils, only: endrun use cam_logfile, only: iulog use spmd_utils, only: npes, mpicom, masterprocid, masterproc, iam - use ppgrid, only: pcols use dyn_grid, only: get_dyn_grid_info, physgrid_copy_attributes_d use cam_grid_support, only: cam_grid_register, cam_grid_attribute_register use cam_grid_support, only: iMap, hclen => max_hcoordname_len use cam_grid_support, only: horiz_coord_t, horiz_coord_create use cam_grid_support, only: cam_grid_attribute_copy, cam_grid_attr_exists use shr_const_mod, only: PI => SHR_CONST_PI + use scamMod, only: scmlon,scmlat,single_column,closeioplatidx,closeioplonidx ! Local variables integer :: index @@ -203,6 +201,7 @@ subroutine phys_grid_init() real(r8), pointer :: latvals(:) real(r8) :: lonmin, latmin integer(iMap), pointer :: grid_map(:,:) + integer(iMap), pointer :: grid_map_scm(:,:) integer(iMap), allocatable :: coord_map(:) type(horiz_coord_t), pointer :: lat_coord type(horiz_coord_t), pointer :: lon_coord @@ -217,10 +216,14 @@ subroutine phys_grid_init() character(len=hclen) :: copy_gridname character(len=*), parameter :: subname = 'phys_grid_init: ' real(r8), parameter :: rarea_sphere = 1.0_r8 / (4.0_r8*PI) + real (r8), allocatable :: dynlats(:),dynlons(:),pos_dynlons(:) + real (r8) :: pos_scmlon,minpoint,testpoint + integer :: scm_col_index, i, num_lev nullify(lonvals) nullify(latvals) nullify(grid_map) + if (single_column) nullify(grid_map_scm) nullify(lat_coord) nullify(lon_coord) nullify(area_d) @@ -235,11 +238,39 @@ subroutine phys_grid_init() call t_startf("phys_grid_init") ! Gather info from the dycore - call get_dyn_grid_info(hdim1_d, hdim2_d, pver, index_top_layer, & + call get_dyn_grid_info(hdim1_d, hdim2_d, num_lev, index_top_layer, & index_bottom_layer, unstructured, dyn_columns) + + ! Set up the physics decomposition + columns_on_task = size(dyn_columns) + + if (single_column) then + allocate(dynlats(columns_on_task),dynlons(columns_on_task),pos_dynlons(columns_on_task)) + dynlats(:) = dyn_columns(:)%lat_deg + dynlons(:) = dyn_columns(:)%lon_deg + + pos_dynlons(:)= mod(dynlons(:) + 360._r8,360._r8) + pos_scmlon = mod(scmlon + 360._r8,360._r8) + + if (unstructured) then + minpoint=1000.0_r8 + do i=1,columns_on_task + testpoint=abs(pos_dynlons(i)-pos_scmlon)+abs(dynlats(i)-scmlat) + if (testpoint < minpoint) then + minpoint=testpoint + scm_col_index=i + endif + enddo + end if + hdim1_d = 1 + hdim2_d = 1 + phys_columns_on_task = 1 + deallocate(dynlats,dynlons,pos_dynlons) + else + phys_columns_on_task = columns_on_task + end if ! hdim1_d * hdim2_d is the total number of columns num_global_phys_cols = hdim1_d * hdim2_d - pverp = pver + 1 !!XXgoldyXX: Can we enforce interface numbering separate from dycore? !!XXgoldyXX: This will work for both CAM and WRF/MPAS physics !!XXgoldyXX: This only has a 50% chance of working on a single level model @@ -251,14 +282,12 @@ subroutine phys_grid_init() index_top_interface = index_top_layer + 1 end if - ! Set up the physics decomposition - columns_on_task = size(dyn_columns) if (allocated(phys_columns)) then deallocate(phys_columns) end if - allocate(phys_columns(columns_on_task)) - if (columns_on_task > 0) then - col_index = columns_on_task + allocate(phys_columns(phys_columns_on_task)) + if (phys_columns_on_task > 0) then + col_index = phys_columns_on_task num_chunks = col_index / pcols if ((num_chunks * pcols) < col_index) then num_chunks = num_chunks + 1 @@ -273,13 +302,20 @@ subroutine phys_grid_init() col_index = 0 ! Simple chunk assignment do index = begchunk, endchunk - chunks(index)%ncols = MIN(pcols, (columns_on_task - col_index)) + chunks(index)%ncols = MIN(pcols, (phys_columns_on_task - col_index)) chunks(index)%chunk_index = index allocate(chunks(index)%phys_cols(chunks(index)%ncols)) do phys_col = 1, chunks(index)%ncols col_index = col_index + 1 ! Copy information supplied by the dycore - phys_columns(col_index) = dyn_columns(col_index) + if (single_column) then + phys_columns(col_index) = dyn_columns(scm_col_index) +! !scm physics only has 1 global column + phys_columns(col_index)%global_col_num = 1 + phys_columns(col_index)%coord_indices(:)=scm_col_index + else + phys_columns(col_index) = dyn_columns(col_index) + end if ! Fill in physics decomp info phys_columns(col_index)%phys_task = iam phys_columns(col_index)%local_phys_chunk = index @@ -299,10 +335,13 @@ subroutine phys_grid_init() ! unstructured if (unstructured) then allocate(grid_map(3, pcols * (endchunk - begchunk + 1))) + if (single_column) allocate(grid_map_scm(3, pcols * (endchunk - begchunk + 1))) else allocate(grid_map(4, pcols * (endchunk - begchunk + 1))) + if (single_column) allocate(grid_map_scm(4, pcols * (endchunk - begchunk + 1))) end if grid_map = 0_iMap + if (single_column) grid_map_scm = 0_iMap allocate(latvals(size(grid_map, 2))) allocate(lonvals(size(grid_map, 2))) @@ -330,22 +369,29 @@ subroutine phys_grid_init() end if grid_map(1, index) = int(icol, iMap) grid_map(2, index) = int(ichnk, iMap) + if (single_column) then + grid_map_scm(1, index) = int(icol, iMap) + grid_map_scm(2, index) = int(ichnk, iMap) + end if if (icol <= ncol) then if (unstructured) then gcol = phys_columns(col_index)%global_col_num if (gcol > 0) then - grid_map(3, index) = int(gcol, iMap) + grid_map(3, index) = int(gcol, iMap) + if (single_column) grid_map_scm(3, index) = closeioplonidx end if ! else entry remains 0 else ! lon gcol = phys_columns(col_index)%coord_indices(1) if (gcol > 0) then grid_map(3, index) = int(gcol, iMap) + if (single_column) grid_map_scm(3, index) = closeioplonidx end if ! else entry remains 0 ! lat gcol = phys_columns(col_index)%coord_indices(2) if (gcol > 0) then grid_map(4, index) = gcol + if (single_column) grid_map_scm(4, index) = closeioplatidx end if ! else entry remains 0 end if end if ! Else entry remains 0 @@ -398,6 +444,8 @@ subroutine phys_grid_init() end if call cam_grid_register('physgrid', phys_decomp, lat_coord, lon_coord, & grid_map, unstruct=unstructured, block_indexed=.true.) + if (single_column) call cam_grid_register('physgrid_scm', phys_decomp_scm, lat_coord, lon_coord, & + grid_map_scm, unstruct=unstructured, block_indexed=.true.) ! Copy required attributes from the dynamics array nullify(copy_attributes) call physgrid_copy_attributes_d(copy_gridname, copy_attributes) @@ -414,7 +462,7 @@ subroutine phys_grid_init() ! (Note, a separate physics grid is only supported for ! unstructured grids). allocate(area_d(size(grid_map, 2))) - do col_index = 1, columns_on_task + do col_index = 1, phys_columns_on_task area_d(col_index) = phys_columns(col_index)%area end do call cam_grid_attribute_register('physgrid', 'area', & @@ -422,7 +470,7 @@ subroutine phys_grid_init() nullify(area_d) ! Belongs to attribute now allocate(areawt_d(size(grid_map, 2))) - do col_index = 1, columns_on_task + do col_index = 1, phys_columns_on_task areawt_d(col_index) = phys_columns(col_index)%weight*rarea_sphere end do call cam_grid_attribute_register('physgrid', 'areawt', & @@ -433,16 +481,17 @@ subroutine phys_grid_init() end if end if ! Cleanup pointers (they belong to the grid now) - nullify(grid_map) - deallocate(latvals) - nullify(latvals) - deallocate(lonvals) - nullify(lonvals) ! Cleanup, we are responsible for copy attributes if (associated(copy_attributes)) then deallocate(copy_attributes) nullify(copy_attributes) end if + nullify(grid_map) + if (single_column) nullify(grid_map_scm) + deallocate(latvals) + nullify(latvals) + deallocate(lonvals) + nullify(lonvals) ! Set flag indicating physics grid is now set phys_grid_set = .true. @@ -526,7 +575,7 @@ end function phys_grid_initialized !======================================================================== integer function get_nlcols_p() - get_nlcols_p = columns_on_task + get_nlcols_p = phys_columns_on_task end function get_nlcols_p !======================================================================== @@ -1106,7 +1155,6 @@ end subroutine dump_grid_map subroutine scatter_field_to_chunk(fdim,mdim,ldim, & hdim1d,globalfield,localchunks) use cam_abortutils, only: endrun - use ppgrid, only: pcols !----------------------------------------------------------------------- ! ! Purpose: DUMMY FOR WEAK SCALING TESTS 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/aoa_tracers.F90 b/src/physics/cam/aoa_tracers.F90 index f13660b327..f0c272b69d 100644 --- a/src/physics/cam/aoa_tracers.F90 +++ b/src/physics/cam/aoa_tracers.F90 @@ -11,10 +11,11 @@ module aoa_tracers use constituents, only: pcnst, cnst_add, cnst_name, cnst_longname use cam_logfile, only: iulog use ref_pres, only: pref_mid_norm + use time_manager, only: get_curr_date, get_start_date + use time_manager, only: is_leapyear, timemgr_get_calendar_cf, get_calday implicit none private - save ! Public interfaces public :: aoa_tracers_register ! register constituents @@ -27,19 +28,18 @@ module aoa_tracers ! Private module data - integer, parameter :: ncnst=4 ! number of constituents implemented by this module + integer, parameter :: ncnst=3 ! number of constituents implemented by this module ! constituent names - character(len=8), parameter :: c_names(ncnst) = (/'AOA1', 'AOA2', 'HORZ', 'VERT'/) + character(len=6), parameter :: c_names(ncnst) = (/'AOAMF ', 'HORZ ', 'VERT '/) ! constituent source/sink names - character(len=8), parameter :: src_names(ncnst) = (/'AOA1SRC', 'AOA2SRC', 'HORZSRC', 'VERTSRC'/) + character(len=8), parameter :: src_names(ncnst) = (/'AOAMFSRC', 'HORZSRC ', 'VERTSRC '/) - integer :: ifirst ! global index of first constituent - integer :: ixaoa1 ! global index for AOA1 tracer - integer :: ixaoa2 ! global index for AOA2 tracer - integer :: ixht ! global index for HORZ tracer - integer :: ixvt ! global index for VERT tracer + integer :: ifirst = -1 ! global index of first constituent + integer :: ixaoa = -1 ! global index for AOAMFSRC tracer + integer :: ixht = -1 ! global index for HORZ tracer + integer :: ixvt = -1 ! global index for VERT tracer ! Data from namelist variables logical :: aoa_tracers_flag = .false. ! true => turn on test tracer code, namelist variable @@ -66,7 +66,11 @@ module aoa_tracers ! Troposphere and Stratosphere. J. Atmos. Sci., 57, 673-699. ! doi: http://dx.doi.org/10.1175/1520-0469(2000)057<0673:TDOGAI>2.0.CO;2 - real(r8) :: qrel_vert(pver) ! = -7._r8*log(pref_mid_norm(k)) + vert_offset + real(r8) :: qrel_vert(pver) = -huge(1._r8) ! = -7._r8*log(pref_mid_norm(k)) + vert_offset + + integer :: yr0 = -huge(1) + real(r8) :: calday0 = -huge(1._r8) + real(r8) :: years = -huge(1._r8) !=============================================================================== contains @@ -75,12 +79,9 @@ module aoa_tracers !================================================================================ subroutine aoa_tracers_readnl(nlfile) - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use mpishorthand - use cam_abortutils, only: endrun - - implicit none + use namelist_utils, only: find_group_name + use cam_abortutils, only: endrun + use spmd_utils, only: mpicom, masterprocid, mpi_logical, mpi_success character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -88,14 +89,12 @@ subroutine aoa_tracers_readnl(nlfile) integer :: unitn, ierr character(len=*), parameter :: subname = 'aoa_tracers_readnl' - namelist /aoa_tracers_nl/ aoa_tracers_flag, aoa_read_from_ic_file !----------------------------------------------------------------------------- if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) + open( newunit=unitn, file=trim(nlfile), status='old' ) call find_group_name(unitn, 'aoa_tracers_nl', status=ierr) if (ierr == 0) then read(unitn, aoa_tracers_nl, iostat=ierr) @@ -104,13 +103,16 @@ subroutine aoa_tracers_readnl(nlfile) end if end if close(unitn) - call freeunit(unitn) end if -#ifdef SPMD - call mpibcast(aoa_tracers_flag, 1, mpilog, 0, mpicom) - call mpibcast(aoa_read_from_ic_file, 1, mpilog, 0, mpicom) -#endif + call mpi_bcast(aoa_tracers_flag, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//': MPI_BCAST ERROR: aoa_tracers_flag') + end if + call mpi_bcast(aoa_read_from_ic_file, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//': MPI_BCAST ERROR: aoa_read_from_ic_file') + end if endsubroutine aoa_tracers_readnl @@ -125,18 +127,24 @@ subroutine aoa_tracers_register use physconst, only: cpair, mwdry !----------------------------------------------------------------------- + integer :: k + if (.not. aoa_tracers_flag) return - call cnst_add(c_names(1), mwdry, cpair, 0._r8, ixaoa1, readiv=aoa_read_from_ic_file, & - longname='Age-of_air tracer 1') - ifirst = ixaoa1 - call cnst_add(c_names(2), mwdry, cpair, 0._r8, ixaoa2, readiv=aoa_read_from_ic_file, & - longname='Age-of_air tracer 2') - call cnst_add(c_names(3), mwdry, cpair, 1._r8, ixht, readiv=aoa_read_from_ic_file, & + call cnst_add(c_names(1), mwdry, cpair, 0._r8, ixaoa, readiv=aoa_read_from_ic_file, & + longname='mixing ratio LB tracer') + + call cnst_add(c_names(2), mwdry, cpair, 1._r8, ixht, readiv=aoa_read_from_ic_file, & longname='horizontal tracer') - call cnst_add(c_names(4), mwdry, cpair, 0._r8, ixvt, readiv=aoa_read_from_ic_file, & + call cnst_add(c_names(3), mwdry, cpair, 0._r8, ixvt, readiv=aoa_read_from_ic_file, & longname='vertical tracer') + ifirst = ixaoa + + do k = 1,pver + qrel_vert(k) = -7._r8*log(pref_mid_norm(k)) + vert_offset + enddo + end subroutine aoa_tracers_register !=============================================================================== @@ -211,7 +219,9 @@ subroutine aoa_tracers_init use cam_history, only: addfld, add_default - integer :: m, mm, k + integer :: m, mm + integer :: yr, mon, day, sec, ymd + !----------------------------------------------------------------------- if (.not. aoa_tracers_flag) return @@ -227,9 +237,12 @@ subroutine aoa_tracers_init call add_default (src_names(m), 1, ' ') end do - do k = 1,pver - qrel_vert(k) = -7._r8*log(pref_mid_norm(k)) + vert_offset - enddo + call get_start_date(yr, mon, day, sec) + + ymd = yr*10000 + mon*100 + day + + yr0 = yr + calday0 = get_calday(ymd, sec) end subroutine aoa_tracers_init @@ -240,15 +253,14 @@ subroutine aoa_tracers_timestep_init( phys_state ) ! Provides a place to reinitialize diagnostic constituents HORZ and VERT !----------------------------------------------------------------------- - use time_manager, only: get_curr_date use ppgrid, only: begchunk, endchunk use physics_types, only: physics_state type(physics_state), intent(inout), dimension(begchunk:endchunk), optional :: phys_state - integer c, i, k, ncol - integer yr, mon, day, tod + integer yr, mon, day, tod, ymd + real(r8) :: calday, dpy !-------------------------------------------------------------------------- if (.not. aoa_tracers_flag) return @@ -272,29 +284,34 @@ subroutine aoa_tracers_timestep_init( phys_state ) end if + ymd = yr*10000 + mon*100 + day + calday = get_calday(ymd, tod) + + dpy = 365._r8 + if (timemgr_get_calendar_cf() == 'gregorian' .and. is_leapyear(yr)) then + dpy = 366._r8 + end if + years = (yr-yr0) + (calday-calday0)/dpy + end subroutine aoa_tracers_timestep_init !=============================================================================== - subroutine aoa_tracers_timestep_tend(state, ptend, cflx, landfrac, dt) + subroutine aoa_tracers_timestep_tend(state, ptend, dt) use physics_types, only: physics_state, physics_ptend, physics_ptend_init use cam_history, only: outfld - use time_manager, only: get_nstep ! Arguments type(physics_state), intent(in) :: state ! state variables type(physics_ptend), intent(out) :: ptend ! package tendencies - real(r8), intent(inout) :: cflx(pcols,pcnst) ! Surface constituent flux (kg/m^2/s) - real(r8), intent(in) :: landfrac(pcols) ! Land fraction - real(r8), intent(in) :: dt ! timestep + real(r8), intent(in) :: dt ! timestep size (sec) !----------------- Local workspace------------------------------- integer :: i, k integer :: lchnk ! chunk identifier integer :: ncol ! no. of column in chunk - integer :: nstep ! current timestep number real(r8) :: qrel ! value to be relaxed to real(r8) :: xhorz ! updated value of HORZ real(r8) :: xvert ! updated value of VERT @@ -302,6 +319,11 @@ subroutine aoa_tracers_timestep_tend(state, ptend, cflx, landfrac, dt) real(r8) :: teul ! relaxation in 1/sec*dt/2 = k*dt/2 real(r8) :: wimp ! 1./(1.+ k*dt/2) real(r8) :: wsrc ! teul*wimp + + real(r8) :: xmmr + real(r8), parameter :: mmr0 = 1.0e-6_r8 ! initial lower boundary mmr + real(r8), parameter :: per_yr = 0.02_r8 ! fractional increase per year + !------------------------------------------------------------------ teul = .5_r8*dt/(86400._r8 * treldays) ! 1/2 for the semi-implicit scheme if dt=time step @@ -313,26 +335,23 @@ subroutine aoa_tracers_timestep_tend(state, ptend, cflx, landfrac, dt) return end if - lq(:) = .FALSE. - lq(ixaoa1) = .TRUE. - lq(ixaoa2) = .TRUE. - lq(ixht) = .TRUE. - lq(ixvt) = .TRUE. + lq(:) = .FALSE. + lq(ixaoa) = .TRUE. + lq(ixht) = .TRUE. + lq(ixvt) = .TRUE. + call physics_ptend_init(ptend,state%psetcols, 'aoa_tracers', lq=lq) - nstep = get_nstep() lchnk = state%lchnk ncol = state%ncol + ! AOAMF + xmmr = mmr0*(1._r8 + per_yr*years) + ptend%q(1:ncol,pver,ixaoa) = (xmmr - state%q(1:ncol,pver,ixaoa)) / dt + do k = 1, pver do i = 1, ncol - ! AOA1 - ptend%q(i,k,ixaoa1) = 0.0_r8 - - ! AOA2 - ptend%q(i,k,ixaoa2) = 0.0_r8 - ! HORZ qrel = 2._r8 + sin(state%lat(i)) ! qrel should zonal mean xhorz = state%q(i,k,ixht)*wimp + wsrc*qrel ! Xnew = weight*3D-tracer + (1.-weight)*1D-tracer @@ -344,34 +363,13 @@ subroutine aoa_tracers_timestep_tend(state, ptend, cflx, landfrac, dt) ptend%q(i,k,ixvt) = (xvert - state%q(i,k,ixvt)) / dt end do + end do ! record tendencies on history files - call outfld (src_names(1), ptend%q(:,:,ixaoa1), pcols, lchnk) - call outfld (src_names(2), ptend%q(:,:,ixaoa2), pcols, lchnk) - call outfld (src_names(3), ptend%q(:,:,ixht), pcols, lchnk) - call outfld (src_names(4), ptend%q(:,:,ixvt), pcols, lchnk) - - ! Set tracer fluxes - do i = 1, ncol - - ! AOA1 - cflx(i,ixaoa1) = 1.e-6_r8 - - ! AOA2 - if (landfrac(i) .eq. 1._r8 .and. state%lat(i) .gt. 0.35_r8) then - cflx(i,ixaoa2) = 1.e-6_r8 + 1e-6_r8*0.0434_r8*real(nstep,r8)*dt/(86400._r8*365._r8) - else - cflx(i,ixaoa2) = 0._r8 - endif - - ! HORZ - cflx(i,ixht) = 0._r8 - - ! VERT - cflx(i,ixvt) = 0._r8 - - end do + call outfld (src_names(1), ptend%q(:,:,ixaoa), pcols, lchnk) + call outfld (src_names(2), ptend%q(:,:,ixht), pcols, lchnk) + call outfld (src_names(3), ptend%q(:,:,ixvt), pcols, lchnk) end subroutine aoa_tracers_timestep_tend @@ -389,19 +387,17 @@ subroutine init_cnst_3d(m, latvals, lonvals, mask, q) !----------------------------------------------------------------------- if (masterproc) then - write(iulog,*) 'AGE-OF-AIR CONSTITUENTS: INITIALIZING ',cnst_name(m),m + write(iulog,*) 'AGE-OF-AIR CONSTITUENTS: INITIALIZING ',cnst_name(m),m end if - if (m == ixaoa1) then - - q(:,:) = 0.0_r8 - - else if (m == ixaoa2) then + if (m == ixaoa) then + ! AOAMF q(:,:) = 0.0_r8 else if (m == ixht) then + ! HORZ gsize = size(q, 1) do j = 1, gsize q(j,:) = 2._r8 + sin(latvals(j)) @@ -409,6 +405,7 @@ subroutine init_cnst_3d(m, latvals, lonvals, mask, q) else if (m == ixvt) then + ! VERT do k = 1, pver do j = 1, size(q,1) q(j,k) = qrel_vert(k) @@ -421,5 +418,4 @@ end subroutine init_cnst_3d !===================================================================== - end module aoa_tracers diff --git a/src/physics/cam/cam3_aero_data.F90 b/src/physics/cam/cam3_aero_data.F90 deleted file mode 100644 index bb32e36b8a..0000000000 --- a/src/physics/cam/cam3_aero_data.F90 +++ /dev/null @@ -1,1021 +0,0 @@ -module cam3_aero_data -!----------------------------------------------------------------------- -! -! Purposes: -! read, store, interpolate, and return fields -! of aerosols to CAM. The initialization -! file (mass.nc) is assumed to be a monthly climatology -! of aerosols from MATCH (on a sigma pressure -! coordinate system). -! also provide a "background" aerosol field to correct -! for any deficiencies in the physical parameterizations -! This fields is a "tuning" parameter. -! Public methods: -! (1) - initialization -! read aerosol masses from external file -! also pressure coordinates -! convert from monthly average values to mid-month values -! (2) - interpolation (time and vertical) -! interpolate onto pressure levels of CAM -! interpolate to time step of CAM -! return mass of aerosols -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use shr_scam_mod, only: shr_scam_GetCloseLatLon - use spmd_utils, only: masterproc - use ppgrid, only: pcols, pver, pverp, begchunk, endchunk - use phys_grid, only: get_ncols_p, scatter_field_to_chunk - use time_manager, only: get_curr_calday - use infnan, only: nan, assignment(=) - use cam_abortutils, only: endrun - use scamMod, only: scmlon,scmlat,single_column - use error_messages, only: handle_ncerr - use physics_types, only: physics_state - use boundarydata, only: boundarydata_init, boundarydata_type - use perf_mod, only: t_startf, t_stopf - use cam_logfile, only: iulog - use netcdf - - implicit none - private - save - - public :: & - cam3_aero_data_readnl, & ! read namelist - cam3_aero_data_register, & ! register these aerosols with pbuf2d - cam3_aero_data_init, & ! read from file, interpolate onto horiz grid - cam3_aero_data_timestep_init ! update data-aerosols to this timestep - - ! namelist variables - logical, public :: cam3_aero_data_on = .false. - character(len=256) :: bndtvaer = 'bndtvaer' ! full pathname for time-variant aerosol mass climatology dataset - - ! naer is number of species in climatology - integer, parameter :: naer = 11 - - real(r8), parameter :: wgt_sscm = 6.0_r8 / 7.0_r8 ! Fraction of total seasalt mass in coarse mode - - ! indices to aerosol array (species portion) - integer, parameter :: & - idxSUL = 1, & - idxSSLTA = 2, & ! accumulation mode - idxSSLTC = 3, & ! coarse mode - idxOCPHO = 8, & - idxBCPHO = 9, & - idxOCPHI = 10, & - idxBCPHI = 11 - - ! indices to sections of array that represent - ! groups of aerosols - integer, parameter :: & - idxSSLTfirst = 2, numSSLT = 2, & - idxDUSTfirst = 4, & - numDUST = 4, & - idxCARBONfirst = 8, & - numCARBON = 4 - - ! names of aerosols are they are represented in - ! the climatology file. - ! Appended '_V' indicates field has been vertically summed. - character(len=8), parameter :: aerosol_name(naer) = & - (/"MSUL_V "& - ,"MSSLTA_V"& - ,"MSSLTC_V"& - ,"MDUST1_V"& - ,"MDUST2_V"& - ,"MDUST3_V"& - ,"MDUST4_V"& - ,"MOCPHO_V"& - ,"MBCPHO_V"& - ,"MOCPHI_V"& - ,"MBCPHI_V"/) - - ! number of different "groups" of aerosols - integer, parameter :: num_aer_groups=4 - - ! which group does each bin belong to? - integer, dimension(naer), parameter :: & - group =(/1,2,2,3,3,3,3,4,4,4,4/) - - ! name of each group - character(len=10), dimension(num_aer_groups), parameter :: & - aerosol_names = (/'sul ','sslt ','dust ','car '/) - - ! this boundarydata_type is used for datasets in the ncols format only. - type(boundarydata_type) :: aerosol_datan - - integer :: aernid = -1 ! netcdf id for aerosol file (init to invalid) - integer :: species_id(naer) = -1 ! netcdf_id of each aerosol species (init to invalid) - integer :: Mpsid ! netcdf id for MATCH PS - integer :: nm = 1 ! index to prv month in array. init to 1 and toggle between 1 and 2 - integer :: np = 2 ! index to nxt month in array. init to 2 and toggle between 1 and 2 - integer :: mo_nxt = huge(1) ! index to nxt month in file - - real(r8) :: cdaym ! calendar day of prv month - real(r8) :: cdayp ! calendar day of next month - - ! aerosol mass - real(r8), allocatable :: aer_mass(:, :, :, :) - - ! Days into year for mid month date - ! This variable is dumb, the dates are in the dataset to be read in but they are - ! slightly different than this so getting rid of it causes a change which - ! exceeds roundoff. - real(r8) :: Mid(12) = (/16.5_r8, 46.0_r8, 75.5_r8, 106.0_r8, 136.5_r8, 167.0_r8, & - 197.5_r8, 228.5_r8, 259.0_r8, 289.5_r8, 320.0_r8, 350.5_r8 /) - - ! values read from file and temporary values used for interpolation - ! - ! aerosolc is: - ! Cumulative Mass at midpoint of each month - ! on CAM's horizontal grid (col) - ! on MATCH's levels (lev) - ! aerosolc - integer, parameter :: paerlev = 28 ! number of levels for aerosol fields (MUST = naerlev) - integer :: naerlev ! size of level dimension in MATCH data - integer :: naerlon - integer :: naerlat - real(r8), pointer :: M_hybi(:) ! MATCH hybi - real(r8), pointer :: M_ps(:,:) ! surface pressure from MATCH file - real(r8), pointer :: aerosolc(:,:,:,:,:) ! Aerosol cumulative mass from MATCH - real(r8), pointer :: M_ps_cam_col(:,:,:) ! PS from MATCH on Cam Columns - - ! indices for fields in the physics buffer - integer :: cam3_sul_idx, cam3_ssam_idx, cam3_sscm_idx, & - cam3_dust1_idx, cam3_dust2_idx, cam3_dust3_idx, cam3_dust4_idx,& - cam3_ocpho_idx, cam3_bcpho_idx, cam3_ocphi_idx, cam3_bcphi_idx - -!================================================================================================ -contains -!================================================================================================ - -subroutine cam3_aero_data_readnl(nlfile) - - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use mpishorthand - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: subname = 'cam3_aero_data_readnl' - - namelist /cam3_aero_data_nl/ cam3_aero_data_on, bndtvaer - !----------------------------------------------------------------------------- - - if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'cam3_aero_data_nl', status=ierr) - if (ierr == 0) then - read(unitn, cam3_aero_data_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(subname // ':: ERROR reading namelist') - end if - end if - close(unitn) - call freeunit(unitn) - end if - -#ifdef SPMD - ! Broadcast namelist variables - call mpibcast(cam3_aero_data_on, 1, mpilog, 0, mpicom) - call mpibcast(bndtvaer, len(bndtvaer), mpichar, 0, mpicom) -#endif - - ! Prevent using these before they are set. - cdaym = nan - cdayp = nan - -end subroutine cam3_aero_data_readnl - -!================================================================================================ - -subroutine cam3_aero_data_register - - ! register old prescribed aerosols with physics buffer - - use physics_buffer, only: pbuf_add_field, dtype_r8 - - call pbuf_add_field('cam3_sul', 'physpkg',dtype_r8,(/pcols,pver/),cam3_sul_idx) - call pbuf_add_field('cam3_ssam', 'physpkg',dtype_r8,(/pcols,pver/),cam3_ssam_idx) - call pbuf_add_field('cam3_sscm', 'physpkg',dtype_r8,(/pcols,pver/),cam3_sscm_idx) - call pbuf_add_field('cam3_dust1','physpkg',dtype_r8,(/pcols,pver/),cam3_dust1_idx) - call pbuf_add_field('cam3_dust2','physpkg',dtype_r8,(/pcols,pver/),cam3_dust2_idx) - call pbuf_add_field('cam3_dust3','physpkg',dtype_r8,(/pcols,pver/),cam3_dust3_idx) - call pbuf_add_field('cam3_dust4','physpkg',dtype_r8,(/pcols,pver/),cam3_dust4_idx) - call pbuf_add_field('cam3_ocpho','physpkg',dtype_r8,(/pcols,pver/),cam3_ocpho_idx) - call pbuf_add_field('cam3_bcpho','physpkg',dtype_r8,(/pcols,pver/),cam3_bcpho_idx) - call pbuf_add_field('cam3_ocphi','physpkg',dtype_r8,(/pcols,pver/),cam3_ocphi_idx) - call pbuf_add_field('cam3_bcphi','physpkg',dtype_r8,(/pcols,pver/),cam3_bcphi_idx) - -end subroutine cam3_aero_data_register - -!================================================================================================ - -subroutine cam3_aero_data_init(phys_state) -!------------------------------------------------------------------ -! Reads in: -! file from which to read aerosol Masses on CAM grid. Currently -! assumed to be MATCH ncep runs, averaged by month. -! NOTE (Data have been externally interpolated onto CAM grid -! and backsolved to provide Mid-month values) -! -! Populates: -! module variables: -! aerosolc(pcols,paerlev+1,begchunk:endchunk,naer,2)) -! aerosolc( column_index -! , level_index (match levels) -! , chunk_index -! , species_index -! , month = 1:2 ) -! M_hybi(level_index = Lev_MATCH) = pressure at mid-level. -! M_ps_cam_col(column,chunk,month) ! PS from MATCH on Cam Columns -! -! Method: -! read data from file -! allocate memory for storage of aerosol data on CAM horizontal grid -! distribute data to remote nodes -! populates the module variables -! -!------------------------------------------------------------------ - use ioFileMod, only: getfil - -#if ( defined SPMD ) - use mpishorthand -#endif - type(physics_state), intent(in) :: phys_state(begchunk:endchunk) - -! local variables - - integer :: naerlev - - integer dateid ! netcdf id for date variable - integer secid ! netcdf id for seconds variable - integer londimid ! netcdf id for longitude dimension - integer latdimid ! netcdf id for latitude dimension - integer levdimid ! netcdf id for level dimension - - integer timesiz ! number of time samples (=12) in netcdf file - integer latid ! netcdf id for latitude variable - integer Mhybiid ! netcdf id for MATCH hybi - integer timeid ! netcdf id for time variable - integer dimids(nf90_max_var_dims) ! variable shape - integer :: start(4) ! start vector for netcdf calls - integer :: kount(4) ! count vector for netcdf calls - integer mo ! month index - integer m ! constituent index - integer :: n ! loop index - integer :: i,j,k ! spatial indices - integer :: date_aer(12) ! Date on aerosol dataset (YYYYMMDD) - integer :: attnum ! attribute number - integer :: ierr ! netcdf return code - real(r8) :: coldata(paerlev) ! aerosol field read in from dataset - integer :: ret - integer mo_prv ! index to previous month - integer latidx,lonidx - - character(len=8) :: aname ! temporary aerosol name - character(len=8) :: tmp_aero_name(naer) ! name for input to boundary data - - character(len=256) :: locfn ! netcdf local filename to open -! -! aerosol_data will be read in from the aerosol boundary dataset, then scattered to chunks -! after filling in the bottom level with zeros -! - real(r8), allocatable :: aerosol_data(:,:,:) ! aerosol field read in from dataset - real(r8), allocatable :: aerosol_field(:,:,:) ! (plon,paerlev+1,plat) aerosol field to be scattered - real(r8) :: caldayloc ! calendar day of current timestep - real(r8) :: closelat,closelon - - character(len=*), parameter :: subname = 'cam3_aero_data_init' - !------------------------------------------------------------------ - - call t_startf(subname) - - allocate (aer_mass(pcols, pver, naer, begchunk:endchunk) ) - - ! set new aerosol names because input file has 1 seasalt bin - do m = 1, naer - tmp_aero_name(m)=aerosol_name(m) - if (aerosol_name(m)=='MSSLTA_V') tmp_aero_name(m) = 'MSSLT_V' - if (aerosol_name(m)=='MSSLTC_V') tmp_aero_name(m) = 'MSSLT_V' - end do - - allocate (aerosolc(pcols,paerlev+1,begchunk:endchunk,naer,2)) - aerosolc(:,:,:,:,:) = 0._r8 - - caldayloc = get_curr_calday () - - if (caldayloc < Mid(1)) then - mo_prv = 12 - mo_nxt = 1 - else if (caldayloc >= Mid(12)) then - mo_prv = 12 - mo_nxt = 1 - else - do i = 2 , 12 - if (caldayloc < Mid(i)) then - mo_prv = i-1 - mo_nxt = i - exit - end if - end do - end if - - ! Set initial calendar day values - cdaym = Mid(mo_prv) - cdayp = Mid(mo_nxt) - - if (masterproc) & - write(iulog,*) subname//': CAM3 prescribed aerosol dataset is: ', trim(bndtvaer) - - call getfil (bndtvaer, locfn, 0) - - call handle_ncerr( nf90_open (locfn, 0, aernid),& - subname, __LINE__) - - if (single_column) & - call shr_scam_GetCloseLatLon(aernid,scmlat,scmlon,closelat,closelon,latidx,lonidx) - - ! Check to see if this dataset is in ncol format. - aerosol_datan%isncol=.false. - ierr = nf90_inq_dimid( aernid, 'ncol', londimid ) - if ( ierr==NF90_NOERR ) then - - aerosol_datan%isncol=.true. - call handle_ncerr(nf90_close(aernid),subname, __LINE__) - - call boundarydata_init(bndtvaer, phys_state, tmp_aero_name, naer, & - aerosol_datan, 3) - - aerosolc(:,1:paerlev,:,:,:)=aerosol_datan%fields - - M_ps_cam_col=>aerosol_datan%ps - M_hybi=>aerosol_datan%hybi - - else - - ! Allocate memory for dynamic arrays local to this module - allocate (M_ps_cam_col(pcols,begchunk:endchunk,2)) - allocate (M_hybi(paerlev+1)) - ! TBH: HACK to avoid use of uninitialized values when ncols < pcols - M_ps_cam_col(:,:,:) = 0._r8 - - if (masterproc) then - - ! First ensure dataset is CAM-ready - - call handle_ncerr(nf90_inquire_attribute (aernid, nf90_global, 'cam-ready', attnum=attnum),& - subname//': interpaerosols needs to be run to create a cam-ready aerosol dataset') - - ! Get and check dimension info - - call handle_ncerr( nf90_inq_dimid( aernid, 'lon', londimid ),& - subname, __LINE__) - call handle_ncerr( nf90_inq_dimid( aernid, 'lev', levdimid ),& - subname, __LINE__) - call handle_ncerr( nf90_inq_dimid( aernid, 'time', timeid ),& - subname, __LINE__) - call handle_ncerr( nf90_inq_dimid( aernid, 'lat', latdimid ),& - subname, __LINE__) - call handle_ncerr( nf90_inquire_dimension( aernid, londimid, len=naerlon ),& - subname, __LINE__) - call handle_ncerr( nf90_inquire_dimension( aernid, levdimid, len=naerlev ),& - subname, __LINE__) - call handle_ncerr( nf90_inquire_dimension( aernid, latdimid, len=naerlat ),& - subname, __LINE__) - call handle_ncerr( nf90_inquire_dimension( aernid, timeid, len=timesiz ),& - subname, __LINE__) - - call handle_ncerr( nf90_inq_varid( aernid, 'date', dateid ),& - subname, __LINE__) - call handle_ncerr( nf90_inq_varid( aernid, 'datesec', secid ),& - subname, __LINE__) - - do m = 1, naer - aname=aerosol_name(m) - ! rename because file has only one seasalt field - if (aname=='MSSLTA_V') aname = 'MSSLT_V' - if (aname=='MSSLTC_V') aname = 'MSSLT_V' - call handle_ncerr( nf90_inq_varid( aernid, TRIM(aname), species_id(m)), & - subname, __LINE__) - end do - - call handle_ncerr( nf90_inq_varid( aernid, 'lat', latid ),& - subname, __LINE__) - - ! quick sanity check on one field - call handle_ncerr( nf90_inquire_variable (aernid, species_id(1), dimids=dimids),& - subname, __LINE__) - - if ( (dimids(4) /= timeid) .or. & - (dimids(3) /= levdimid) .or. & - (dimids(2) /= latdimid) .or. & - (dimids(1) /= londimid) ) then - write(iulog,*) subname//': Data must be ordered time, lev, lat, lon' - write(iulog,*) 'data are ordered as', dimids(4), dimids(3), dimids(2), dimids(1) - write(iulog,*) 'data should be ordered as', timeid, levdimid, latdimid, londimid - call endrun () - end if - - ! use hybi,PS from MATCH - call handle_ncerr( nf90_inq_varid( aernid, 'hybi', Mhybiid ),& - subname, __LINE__) - call handle_ncerr( nf90_inq_varid( aernid, 'PS', Mpsid ),& - subname, __LINE__) - - ! check dimension order for MATCH's surface pressure - call handle_ncerr( nf90_inquire_variable (aernid, Mpsid, dimids=dimids),& - subname, __LINE__) - if ( (dimids(3) /= timeid) .or. & - (dimids(2) /= latdimid) .or. & - (dimids(1) /= londimid) ) then - write(iulog,*) subname//': Pressure must be ordered time, lat, lon' - write(iulog,*) 'data are ordered as', dimids(3), dimids(2), dimids(1) - write(iulog,*) 'data should be ordered as', timeid, levdimid, latdimid, londimid - call endrun () - end if - - ! read in hybi from MATCH - call handle_ncerr( nf90_get_var (aernid, Mhybiid, M_hybi),& - subname, __LINE__) - - ! Retrieve date and sec variables. - call handle_ncerr( nf90_get_var (aernid, dateid, date_aer),& - subname, __LINE__) - if (timesiz < 12) then - write(iulog,*) subname//': When cycling aerosols, dataset must have 12 consecutive ', & - 'months of data starting with Jan' - write(iulog,*) 'Current dataset has only ',timesiz,' months' - call endrun () - end if - do mo = 1,12 - if (mod(date_aer(mo),10000)/100 /= mo) then - write(iulog,*) subname//': When cycling aerosols, dataset must have 12 consecutive ', & - 'months of data starting with Jan' - write(iulog,*)'Month ',mo,' of dataset says date=',date_aer(mo) - call endrun () - end if - end do - if (single_column) then - naerlat=1 - naerlon=1 - endif - kount(:) = (/naerlon,naerlat,paerlev,1/) - end if ! masterproc - - ! broadcast hybi to nodes - -#if ( defined SPMD ) - call mpibcast (M_hybi, paerlev+1, mpir8, 0, mpicom) - call mpibcast (kount, 3, mpiint, 0, mpicom) - naerlon = kount(1) - naerlat = kount(2) -#endif - allocate(aerosol_field(kount(1),kount(3)+1,kount(2))) - allocate(M_ps(kount(1),kount(2))) - if (masterproc) allocate(aerosol_data(kount(1),kount(2),kount(3))) - - ! Retrieve Aerosol Masses (kg/m^2 in each layer), transpose to model order (lon,lev,lat), - ! then scatter to slaves. - if (nm /= 1 .or. np /= 2) call endrun (subname//': bad nm or np value') - do n=nm,np - if (n == 1) then - mo = mo_prv - else - mo = mo_nxt - end if - - do m=1,naer - if (masterproc) then - if (single_column) then - start(:) = (/lonidx,latidx,1,mo/) - else - start(:) = (/1,1,1,mo/) - endif - kount(:) = (/naerlon,naerlat,paerlev,1/) - - call handle_ncerr( nf90_get_var (aernid, species_id(m),aerosol_data, start, kount),& - subname, __LINE__) - do j=1,naerlat - do k=1,paerlev - aerosol_field(:,k,j) = aerosol_data(:,j,k) - end do - aerosol_field(:,paerlev+1,j) = 0._r8 ! value at bottom - end do - - end if - call scatter_field_to_chunk (1, paerlev+1, 1, naerlon, aerosol_field, & - aerosolc(:,:,:,m,n)) - end do - - ! Retrieve PS from Match - - if (masterproc) then - if (single_column) then - start(:) = (/lonidx,latidx,mo,-1/) - else - start(:) = (/1,1,mo,-1/) - endif - kount(:) = (/naerlon,naerlat,1,-1/) - call handle_ncerr( nf90_get_var(aernid, Mpsid, M_ps,start,kount),& - subname, __LINE__) - end if - call scatter_field_to_chunk (1, 1, 1, naerlon, M_ps(:,:), M_ps_cam_col(:,:,n)) - end do ! n=nm,np (=1,2) - - if(masterproc) deallocate(aerosol_data) - deallocate(aerosol_field) - - end if ! Check to see if this dataset is in ncol format. - - call t_stopf(subname) - -end subroutine cam3_aero_data_init - -!================================================================================================ - -subroutine cam3_aero_data_timestep_init(pbuf2d, phys_state) -!------------------------------------------------------------------ -! -! Input: -! time at which aerosol masses are needed (get_curr_calday()) -! chunk index -! CAM's vertical grid (pint) -! -! Output: -! values for Aerosol Mass at time specified by get_curr_calday -! on vertical grid specified by pint (aer_mass) :: aerosol at time t -! -! Method: -! first determine which indexs of aerosols are the bounding data sets -! interpolate both onto vertical grid aerm(),aerp(). -! from those two, interpolate in time. -! -!------------------------------------------------------------------ - - use interpolate_data, only: get_timeinterp_factors - - use physics_buffer, only: physics_buffer_desc, dtype_r8, pbuf_set_field, pbuf_get_chunk - use cam_logfile, only: iulog - use ppgrid, only: begchunk,endchunk - use physconst, only: gravit - -! -! aerosol fields interpolated to current time step -! on pressure levels of this time step. -! these should be made read-only for other modules -! Is allocation done correctly here? -! - - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - type(physics_state), intent(in), dimension(begchunk:endchunk) :: phys_state - -! -! Local workspace -! - type(physics_buffer_desc), pointer :: phys_buffer_chunk(:) - real(r8) :: pint(pcols,pverp) ! interface pres. - integer :: c ! chunk index - real(r8) caldayloc ! calendar day of current timestep - real(r8) fact1, fact2 ! time interpolation factors - - integer i, k, j ! spatial indices - integer m ! constituent index - integer lats(pcols),lons(pcols) ! latitude and longitudes of column - integer ncol ! number of columns - integer lchnk ! chunk index - - real(r8) speciesmin(naer) ! minimal value for each species -! -! values before current time step "the minus month" -! aerosolm(pcols,pver) is value of preceeding month's aerosol masses -! aerosolp(pcols,pver) is value of next month's aerosol masses -! (think minus and plus or values to left and right of point to be interpolated) -! - real(r8) aerosolm(pcols,pver,naer,begchunk:endchunk) ! aerosol mass from MATCH in column,level at previous (minus) month -! -! values beyond (or at) current time step "the plus month" -! - real(r8) aerosolp(pcols,pver,naer,begchunk:endchunk) ! aerosol mass from MATCH in column,level at next (plus) month - real(r8) :: mass_to_mmr(pcols,pver) - - character(len=*), parameter :: subname = 'cam3_aero_data_timestep_init' - - logical error_found - !------------------------------------------------------------------ - - call aerint(phys_state) - - caldayloc = get_curr_calday () - - ! Determine time interpolation factors. 1st arg says we are cycling 1 year of data - call get_timeinterp_factors (.true., mo_nxt, cdaym, cdayp, caldayloc, & - fact1, fact2, 'GET_AEROSOL:') - - ! interpolate (prv and nxt month) bounding datasets onto cam vertical grid. - ! compute mass mixing ratios on CAMS's pressure coordinate - ! for both the "minus" and "plus" months - ! - ! This loop over chunk could probably be removed by working with the whole - ! begchunk:endchunk group at once. It would require a slight generalization - ! in vert_interpolate. - do c = begchunk,endchunk - - lchnk = phys_state(c)%lchnk - pint = phys_state(c)%pint - ncol = get_ncols_p(c) - - call vert_interpolate (M_ps_cam_col(:,c,nm), pint, nm, aerosolm(:,:,:,c), ncol, c) - call vert_interpolate (M_ps_cam_col(:,c,np), pint, np, aerosolp(:,:,:,c), ncol, c) - - ! Time interpolate. - do m=1,naer - do k=1,pver - do i=1,ncol - aer_mass(i,k,m,c) = aerosolm(i,k,m,c)*fact1 + aerosolp(i,k,m,c)*fact2 - end do - end do - ! Partition seasalt aerosol mass - if (m .eq. idxSSLTA) then - aer_mass(:ncol,:,m,c) = (1._r8-wgt_sscm)*aer_mass(:ncol,:,m,c) ! fraction of seasalt mass in accumulation mode - elseif (m .eq. idxSSLTC) then - aer_mass(:ncol,:,m,c) = wgt_sscm*aer_mass(:ncol,:,m,c) ! fraction of seasalt mass in coarse mode - endif - end do - - ! exit if mass is negative (we have previously set - ! cumulative mass to be a decreasing function.) - speciesmin(:) = 0._r8 ! speciesmin(m) = 0 is minimum mass for each species - - error_found = .false. - do m=1,naer - do k=1,pver - do i=1,ncol - if (aer_mass(i, k, m,c) < speciesmin(m)) error_found = .true. - end do - end do - end do - if (error_found) then - do m=1,naer - do k=1,pver - do i=1,ncol - if (aer_mass(i, k, m,c) < speciesmin(m)) then - write(iulog,*) subname//': negative mass mixing ratio, exiting' - write(iulog,*) 'm, column, pver',m, i, k ,aer_mass(i, k, m,c) - call endrun () - end if - end do - end do - end do - end if - do k = 1, pver - mass_to_mmr(1:ncol,k) = gravit/(pint(1:ncol,k+1)-pint(1:ncol,k)) - enddo - - phys_buffer_chunk => pbuf_get_chunk(pbuf2d, lchnk) - - call pbuf_set_field(phys_buffer_chunk, cam3_sul_idx, aer_mass(1:ncol,:, idxSUL,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_ssam_idx, aer_mass(1:ncol,:, idxSSLTA,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_sscm_idx, aer_mass(1:ncol,:, idxSSLTC,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_dust1_idx, aer_mass(1:ncol,:, idxDUSTfirst,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_dust2_idx, aer_mass(1:ncol,:,idxDUSTfirst+1,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_dust3_idx, aer_mass(1:ncol,:,idxDUSTfirst+2,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_dust4_idx, aer_mass(1:ncol,:,idxDUSTfirst+3,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_ocpho_idx, aer_mass(1:ncol,:, idxOCPHO,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_bcpho_idx, aer_mass(1:ncol,:, idxBCPHO,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_ocphi_idx, aer_mass(1:ncol,:, idxOCPHI,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_bcphi_idx, aer_mass(1:ncol,:, idxBCPHI,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - - enddo ! c = begchunk:endchunk - -end subroutine cam3_aero_data_timestep_init - -!================================================================================================ - -subroutine vert_interpolate (Match_ps, pint, n, aerosol_mass, ncol, c) -!-------------------------------------------------------------------- -! Input: match surface pressure, cam interface pressure, -! month index, number of columns, chunk index -! -! Output: Aerosol mass mixing ratio (aerosol_mass) -! -! Method: -! interpolate column mass (cumulative) from match onto -! cam's vertical grid (pressure coordinate) -! convert back to mass mixing ratio -! -!-------------------------------------------------------------------- - - real(r8), intent(out) :: aerosol_mass(pcols,pver,naer) ! aerosol mass from MATCH - real(r8), intent(in) :: Match_ps(pcols) ! surface pressure at a particular month - real(r8), intent(in) :: pint(pcols,pverp) ! interface pressure from CAM - - integer, intent(in) :: ncol,c ! chunk index and number of columns - integer, intent(in) :: n ! prv or nxt month index -! -! Local workspace -! - integer m ! index to aerosol species - integer kupper(pcols) ! last upper bound for interpolation - integer i, k, kk, kkstart, kount ! loop vars for interpolation - integer isv, ksv, msv ! loop indices to save - - logical bad ! indicates a bad point found - logical lev_interp_comp ! interpolation completed for a level - logical error_found - - real(r8) aerosol(pcols,pverp,naer) ! cumulative mass of aerosol in column beneath upper - ! interface of level in column at particular month - real(r8) dpl, dpu ! lower and upper intepolation factors - real(r8) v_coord ! vertical coordinate - real(r8) AER_diff ! temp var for difference between aerosol masses - - character(len=*), parameter :: subname = 'cam3_aero_data.vert_interpolate' - !----------------------------------------------------------------------- - - call t_startf ('vert_interpolate') -! -! Initialize index array -! - do i=1,ncol - kupper(i) = 1 - end do -! -! assign total mass to topmost level -! - aerosol(:,1,:) = aerosolc(:,1,c,:,n) -! -! At every pressure level, interpolate onto that pressure level -! - do k=2,pver -! -! Top level we need to start looking is the top level for the previous k -! for all longitude points -! - kkstart = paerlev+1 - do i=1,ncol - kkstart = min0(kkstart,kupper(i)) - end do - kount = 0 -! -! Store level indices for interpolation -! -! for the pressure interpolation should be comparing -! pint(column,lev) with M_hybi(lev)*M_ps_cam_col(month,column,chunk) -! - lev_interp_comp = .false. - do kk=kkstart,paerlev - if(.not.lev_interp_comp) then - do i=1,ncol - v_coord = pint(i,k) - if (M_hybi(kk)*Match_ps(i) .lt. v_coord .and. v_coord .le. M_hybi(kk+1)*Match_ps(i)) then - kupper(i) = kk - kount = kount + 1 - end if - end do -! -! If all indices for this level have been found, do the interpolation and -! go to the next level -! -! Interpolate in pressure. -! - if (kount.eq.ncol) then - do m=1,naer - do i=1,ncol - dpu = pint(i,k) - M_hybi(kupper(i))*Match_ps(i) - dpl = M_hybi(kupper(i)+1)*Match_ps(i) - pint(i,k) - aerosol(i,k,m) = & - (aerosolc(i,kupper(i) ,c,m,n)*dpl + & - aerosolc(i,kupper(i)+1,c,m,n)*dpu)/(dpl + dpu) - enddo !i - end do - lev_interp_comp = .true. - end if - end if - end do -! -! If we've fallen through the kk=1,levsiz-1 loop, we cannot interpolate and -! must extrapolate from the bottom or top pressure level for at least some -! of the longitude points. -! - - if(.not.lev_interp_comp) then - do m=1,naer - do i=1,ncol - if (pint(i,k) .lt. M_hybi(1)*Match_ps(i)) then - aerosol(i,k,m) = aerosolc(i,1,c,m,n) - else if (pint(i,k) .gt. M_hybi(paerlev+1)*Match_ps(i)) then - aerosol(i,k,m) = 0.0_r8 - else - dpu = pint(i,k) - M_hybi(kupper(i))*Match_ps(i) - dpl = M_hybi(kupper(i)+1)*Match_ps(i) - pint(i,k) - aerosol(i,k,m) = & - (aerosolc(i,kupper(i) ,c,m,n)*dpl + & - aerosolc(i,kupper(i)+1,c,m,n)*dpu)/(dpl + dpu) - end if - end do - end do - - if (kount.gt.ncol) then - call endrun (subname//': Bad data: non-monotonicity suspected in dependent variable') - end if - end if - end do - -! call t_startf ('vi_checks') -! -! aerosol mass beneath lowest interface (pverp) must be 0 -! - aerosol(1:ncol,pverp,:) = 0._r8 -! -! Set mass in layer to zero whenever it is less than -! 1.e-40 kg/m^2 in the layer -! - do m = 1, naer - do k = 1, pver - do i = 1, ncol - if (aerosol(i,k,m) < 1.e-40_r8) aerosol(i,k,m) = 0._r8 - end do - end do - end do -! -! Set mass in layer to zero whenever it is less than -! 10^-15 relative to column total mass -! - error_found = .false. - do m = 1, naer - do k = 1, pver - do i = 1, ncol - AER_diff = aerosol(i,k,m) - aerosol(i,k+1,m) - if( abs(AER_diff) < 1e-15_r8*aerosol(i,1,m)) then - AER_diff = 0._r8 - end if - aerosol_mass(i,k,m)= AER_diff - if (aerosol_mass(i,k,m) < 0) error_found = .true. - end do - end do - end do - if (error_found) then - do m = 1, naer - do k = 1, pver - do i = 1, ncol - if (aerosol_mass(i,k,m) < 0) then - write(iulog,*) subname//': mass < 0, m, col, lev, mass',m, i, k, aerosol_mass(i,k,m) - write(iulog,*) subname//': aerosol(k),(k+1)',aerosol(i,k,m),aerosol(i,k+1,m) - write(iulog,*) subname//': pint(k+1),(k)',pint(i,k+1),pint(i,k) - write(iulog,*)'n,c',n,c - call endrun() - end if - end do - end do - end do - end if - - call t_stopf ('vert_interpolate') - - return -end subroutine vert_interpolate - -!================================================================================================ - -subroutine aerint (phys_state) - - type(physics_state), intent(in) :: phys_state(begchunk:endchunk) - - integer :: ntmp ! used in index swapping - integer :: start(4) ! start vector for netcdf calls - integer :: kount(4) ! count vector for netcdf calls - integer :: i,j,k ! spatial indices - integer :: m ! constituent index - integer :: cols, cole - integer :: lchnk, ncol - real(r8) :: caldayloc ! calendar day of current timestep - real(r8) :: aerosol_data(naerlon,naerlat,paerlev) ! aerosol field read in from dataset - real(r8) :: aerosol_field(naerlon,paerlev+1,naerlat) ! aerosol field to be scattered - integer latidx,lonidx - real(r8) closelat,closelon - - character(len=*), parameter :: subname = 'cam3_aero_data.aerint' - !----------------------------------------------------------------------- - - if (single_column) & - call shr_scam_GetCloseLatLon(aernid,scmlat,scmlon,closelat,closelon,latidx,lonidx) - -! -! determine if need to read in next month data -! also determine time interpolation factors -! - caldayloc = get_curr_calday () -! -! If model time is past current forward timeslice, then -! masterproc reads in the next timeslice for time interpolation. Messy logic is -! for interpolation between December and January (mo_nxt == 1). Just like -! ozone_data_timestep_init, sstint. -! - if (caldayloc > cdayp .and. .not. (mo_nxt == 1 .and. caldayloc >= cdaym)) then - mo_nxt = mod(mo_nxt,12) + 1 - cdaym = cdayp - cdayp = Mid(mo_nxt) -! -! Check for valid date info -! - if (.not. (mo_nxt == 1 .or. caldayloc <= cdayp)) then - call endrun (subname//': Non-monotonicity suspected in input aerosol data') - end if - - ntmp = nm - nm = np - np = ntmp - - if(aerosol_datan%isncol) then - do lchnk=begchunk,endchunk - ncol=phys_state(lchnk)%ncol - cols=1 - cole=cols+aerosol_datan%count(cols,lchnk)-1 - do while(cole<=ncol) - start=(/aerosol_datan%start(cols,lchnk),mo_nxt,1,-1/) - kount=(/aerosol_datan%count(cols,lchnk),1,-1,-1/) - call handle_ncerr( nf90_get_var(aerosol_datan%ncid, aerosol_datan%psid , & - aerosol_datan%ps(cols:cole,lchnk,np), start(1:2), & - kount(1:2)),& - subname, __LINE__) - start(2)=1 - start(3)=mo_nxt - kount(2)=paerlev - kount(3)=1 - do m=1,naer - call handle_ncerr( nf90_get_var(aerosol_datan%ncid, aerosol_datan%dataid(m) , & - aerosol_datan%fields(cols:cole,:,lchnk,m,np), & - start(1:3), kount(1:3)),& - subname, __LINE__) - - end do - if(cols==ncol) exit - cols=cols+aerosol_datan%count(cols,lchnk) - cole=cols+aerosol_datan%count(cols,lchnk)-1 - end do - end do - aerosolc(:,1:paerlev,:,:,np)=aerosol_datan%fields(:,:,:,:,np) - else - do m=1,naer - if (masterproc) then - if (single_column) then - naerlon=1 - naerlat=1 - start(:) = (/lonidx,latidx,1,mo_nxt/) - else - start(:) = (/1,1,1,mo_nxt/) - endif - kount(:) = (/naerlon,naerlat,paerlev,1/) - call handle_ncerr( nf90_get_var (aernid, species_id(m), aerosol_data, start, kount),& - subname, __LINE__) - - do j=1,naerlat - do k=1,paerlev - aerosol_field(:,k,j) = aerosol_data(:,j,k) - end do - aerosol_field(:,paerlev+1,j) = 0._r8 ! value at bottom - end do - end if - call scatter_field_to_chunk (1, paerlev+1, 1, naerlon, aerosol_field, & - aerosolc(:,:,:,m,np)) - end do -! -! Retrieve PS from Match -! - if (masterproc) then - if (single_column) then - naerlon=1 - naerlat=1 - start(:) = (/lonidx,latidx,mo_nxt,-1/) - else - start(:) = (/1,1,mo_nxt,-1/) - endif - kount(:) = (/naerlon,naerlat,1,-1/) - call handle_ncerr( nf90_get_var (aernid, Mpsid, M_ps, start, kount),& - subname, __LINE__) - write(iulog,*) subname//': Read aerosols data for julian day', Mid(mo_nxt) - end if - call scatter_field_to_chunk (1, 1, 1, naerlon, M_ps(:,:), M_ps_cam_col(:,:,np)) - end if - end if - -end subroutine aerint - -end module cam3_aero_data diff --git a/src/physics/cam/cam3_ozone_data.F90 b/src/physics/cam/cam3_ozone_data.F90 deleted file mode 100644 index 567679fb0d..0000000000 --- a/src/physics/cam/cam3_ozone_data.F90 +++ /dev/null @@ -1,220 +0,0 @@ -module cam3_ozone_data - -!----------------------------------------------------------------------- -! Purpose: -! -! Interpolates zonal ozone datasets used by CAM3 and puts the field 'O3' into -! the physics buffer. -! -! Revision history: -! 2004-07-31 B. Eaton Assemble module from comozp.F90, oznini.F90, oznint.F90, radozn.F90 -! 2004-08-19 B. Eaton Modify ozone_data_vert_interp to return mass mixing ratio. -! 2004-08-30 B. Eaton Add ozone_data_get_cnst method. -! 2008 June B. Eaton Change name to cam3_ozone_data to support backwards compatibility -! for reading the CAM3 ozone data. Add *_readnl method so module -! reads its own namelist. Add cam3_ozone_data_on variable to -! turn the module on from the namelist. By default it's off. -!----------------------------------------------------------------------- - -use shr_kind_mod, only: r8 => shr_kind_r8 -use spmd_utils, only: masterproc -use ppgrid, only: begchunk, endchunk, pcols, pver -use cam_abortutils, only: endrun -use cam_logfile, only: iulog -use physics_types, only: physics_state -use boundarydata, only: boundarydata_type, boundarydata_init, boundarydata_update, & - boundarydata_vert_interp -use mpishorthand - -implicit none -private -save - -! Public methods -public ::& - cam3_ozone_data_readnl, &! get namelist input - cam3_ozone_data_register, &! register ozone with physics buffer - cam3_ozone_data_init, &! open dataset and spatially interpolate data bounding initial time - cam3_ozone_data_timestep_init ! interpolate to current time - -! Namelist variables -logical, public :: cam3_ozone_data_on = .false. ! switch to turn module on/off -logical :: ozncyc = .true. ! .true. => assume annual cycle ozone data -character(len=256) :: bndtvo = ' ' ! full pathname for time-variant ozone dataset - -! Local -integer :: oz_idx ! index into phys_buffer for ozone - -type(boundarydata_type) :: ozonedata -character(len=6), parameter, dimension(1) :: nc_name = (/'OZONE '/) ! constituent names - -!================================================================================================ -contains -!================================================================================================ - -subroutine cam3_ozone_data_readnl(nlfile) - - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use mpishorthand - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: subname = 'cam3_ozone_data_readnl' - - namelist /cam3_ozone_data_nl/ cam3_ozone_data_on, bndtvo, ozncyc - !----------------------------------------------------------------------------- - - if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'cam3_ozone_data_nl', status=ierr) - if (ierr == 0) then - read(unitn, cam3_ozone_data_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(subname // ':: ERROR reading namelist') - end if - end if - close(unitn) - call freeunit(unitn) - end if - -#ifdef SPMD - ! Broadcast namelist variables - call mpibcast(cam3_ozone_data_on, 1, mpilog, 0, mpicom) - call mpibcast(bndtvo, len(bndtvo), mpichar, 0, mpicom) - call mpibcast(ozncyc, 1, mpilog, 0, mpicom) -#endif - -end subroutine cam3_ozone_data_readnl - -!================================================================================================ - -subroutine cam3_ozone_data_register() - use physics_buffer, only : pbuf_add_field, dtype_r8 - - call pbuf_add_field('O3','physpkg',dtype_r8,(/pcols,pver/),oz_idx) - -end subroutine cam3_ozone_data_register - -!================================================================================================ - -subroutine cam3_ozone_data_init(phys_state) -!----------------------------------------------------------------------- -! -! Purpose: Do initial read of time-variant ozone boundary dataset, containing -! ozone mixing ratios as a function of latitude and pressure. Read two -! consecutive months between which the current date lies. Routine -! RADOZ2 then evaluates the two path length integrals (with and without -! pressure weighting) from zero to the interfaces between the input -! levels. It also stores the contribution to the integral from each -! layer. -! -! Method: Call appropriate netcdf wrapper routines and interpolate to model grid -! -! Author: CCM Core Group -! Modified: P. Worley, August 2003, for chunking and performance optimization -! J. Edwards, Dec 2005, functionality now performed by zonalbndrydata -!----------------------------------------------------------------------- - - use cam_history, only: addfld - - type(physics_state), intent(in) :: phys_state(begchunk:endchunk) - !----------------------------------------------------------------------- - - call addfld ('O3VMR', (/ 'lev' /), 'A', 'm3/m3', 'Ozone volume mixing ratio', sampling_seq='rad_lwsw') - - - ! Initialize for one field (arg_4=1) and do not vertically interpolate (arg_6=3) - call boundarydata_init(bndtvo, phys_state, nc_name, 1, ozonedata, 3) - - if (masterproc) then - write(iulog,*)'cam3_ozone_data_init: Initializing CAM3 prescribed ozone' - write(iulog,*)'Time-variant boundary dataset (ozone) is: ', trim(bndtvo) - if (ozncyc) then - write(iulog,*)'OZONE dataset will be reused for each model year' - else - write(iulog,*)'OZONE dataset will not be cycled' - end if - end if - -end subroutine cam3_ozone_data_init - -!================================================================================================ - -subroutine cam3_ozone_data_timestep_init(pbuf2d, phys_state) -!----------------------------------------------------------------------- -! -! Purpose: Interpolate ozone mixing ratios to current time, reading in new monthly -! data if necessary, and spatially interpolating it. -! -! Method: Find next month of ozone data to interpolate. Linearly interpolate -! vertically and horizontally -! -!----------------------------------------------------------------------- - - - use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk - - - type(physics_state), intent(in) :: phys_state(begchunk:endchunk) - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - real(r8),pointer :: tmpptr(:,:) - - integer lchnk - - call boundarydata_update(phys_state, ozonedata) - - do lchnk = begchunk, endchunk - call pbuf_get_field(pbuf_get_chunk(pbuf2d, lchnk), oz_idx, tmpptr) - call ozone_data_get_cnst(phys_state(lchnk), tmpptr) - enddo - -end subroutine cam3_ozone_data_timestep_init - -!================================================================================================ - -subroutine ozone_data_get_cnst(state, q) - - use cam_history, only: outfld - use physconst, only: mwo3 - - type(physics_state), intent(in) :: state - real(r8) :: q(:,:) ! constituent mass mixing ratio - - ! local variables - integer :: lchnk ! chunk identifier - integer :: i, k - real(r8) :: ozmixin(pcols,ozonedata%levsiz) - ! *** N.B. this hardwired mw of dry air needs to be changed to the share value - real(r8), parameter :: mwdry = 28.9644_r8 ! Effective molecular weight of dry air (g/mol) - real(r8), parameter :: mwr = mwo3/mwdry ! convert from the dataset values of vmr to mmr - !------------------------------------------------------------------------------- - - lchnk = state%lchnk - - ozmixin=0._r8 - do k=1,ozonedata%levsiz - do i=1,state%ncol - ozmixin(i,k) = ozonedata%datainst(state%latmapback(i),k,lchnk,1) - end do - end do - call boundarydata_vert_interp(lchnk, state%ncol, ozonedata%levsiz, & - 1, ozonedata%pin, state%pmid, ozmixin , q) - - call outfld('O3VMR', q, pcols, lchnk) - - do k=1,pver - do i=1,state%ncol - q(i,k) = mwr*q(i,k) - end do - end do - -end subroutine ozone_data_get_cnst - -!================================================================================================ - -end module cam3_ozone_data - diff --git a/src/physics/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90 index 392c7a285c..97dad2ba01 100644 --- a/src/physics/cam/cam_diagnostics.F90 +++ b/src/physics/cam/cam_diagnostics.F90 @@ -12,7 +12,7 @@ module cam_diagnostics use physics_buffer, only: physics_buffer_desc, pbuf_add_field, dtype_r8 use physics_buffer, only: dyn_time_lvls, pbuf_get_field, pbuf_get_index, pbuf_old_tim_idx -use cam_history, only: outfld, write_inithist, hist_fld_active, inithist_all +use cam_history, only: outfld, write_inithist, hist_fld_active, inithist_all, write_camiop use cam_history_support, only: max_fieldname_len use constituents, only: pcnst, cnst_name, cnst_longname, cnst_cam_outfld use constituents, only: ptendnam, apcnst, bpcnst, cnst_get_ind @@ -221,7 +221,7 @@ subroutine diag_init_dry(pbuf2d) call register_vector_field('UAP','VAP') call addfld (apcnst(1), (/ 'lev' /), 'A','kg/kg', trim(cnst_longname(1))//' (after physics)') - if (.not.dycore_is('EUL')) then + if (.not.dycore_is('EUL')) then call addfld ('TFIX', horiz_only, 'A', 'K/s', 'T fixer (T equivalent of Energy correction)') end if call addfld ('TTEND_TOT', (/ 'lev' /), 'A', 'K/s', 'Total temperature tendency') @@ -365,7 +365,7 @@ subroutine diag_init_dry(pbuf2d) call add_default ('UAP ' , history_budget_histfile_num, ' ') call add_default ('VAP ' , history_budget_histfile_num, ' ') call add_default (apcnst(1) , history_budget_histfile_num, ' ') - if (.not.dycore_is('EUL')) then + if (.not.dycore_is('EUL')) then call add_default ('TFIX ' , history_budget_histfile_num, ' ') end if end if @@ -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') @@ -899,11 +901,12 @@ subroutine diag_phys_writeout_dry(state, pbuf, p_surf_t) ! Purpose: output dry physics diagnostics ! !----------------------------------------------------------------------- - use physconst, only: gravit, rga, rair, cappa - use time_manager, only: get_nstep - use interpolate_data, only: vertinterp - use tidal_diag, only: tidal_diag_write - use air_composition, only: cpairv, rairv + use physconst, only: gravit, rga, rair, cappa + use time_manager, only: get_nstep + use interpolate_data, only: vertinterp + use tidal_diag, only: tidal_diag_write + use air_composition, only: cpairv, rairv + use cam_diagnostic_utils, only: cpslec !----------------------------------------------------------------------- ! ! Arguments @@ -940,9 +943,7 @@ subroutine diag_phys_writeout_dry(state, pbuf, p_surf_t) call outfld('PHIS ',state%phis, pcols, lchnk ) -#if (defined BFB_CAM_SCAM_IOP ) - call outfld('phis ',state%phis, pcols, lchnk ) -#endif + if (write_camiop) call outfld('phis ',state%phis, pcols, lchnk ) call outfld( 'CPAIRV', cpairv(:ncol,:,lchnk), ncol, lchnk ) call outfld( 'RAIRV', rairv(:ncol,:,lchnk), ncol, lchnk ) @@ -1033,9 +1034,7 @@ subroutine diag_phys_writeout_dry(state, pbuf, p_surf_t) call outfld('OMEGA ',state%omega, pcols, lchnk ) endif -#if (defined BFB_CAM_SCAM_IOP ) - call outfld('omega ',state%omega, pcols, lchnk ) -#endif + if (write_camiop) call outfld('omega ',state%omega, pcols, lchnk ) ftem(:ncol,:) = state%omega(:ncol,:)*state%t(:ncol,:) call outfld('OMEGAT ',ftem, pcols, lchnk ) @@ -1697,9 +1696,7 @@ subroutine diag_conv(state, ztodt, pbuf) call outfld('PRECLav ', precl, pcols, lchnk ) call outfld('PRECCav ', precc, pcols, lchnk ) -#if ( defined BFB_CAM_SCAM_IOP ) - call outfld('Prec ' , prect, pcols, lchnk ) -#endif + if (write_camiop) call outfld('Prec ' , prect, pcols, lchnk ) ! Total convection tendencies. @@ -1785,6 +1782,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) @@ -1794,11 +1794,13 @@ subroutine diag_surf (cam_in, cam_out, state, pbuf) call outfld('RHREFHT', ftem, pcols, lchnk) -#if (defined BFB_CAM_SCAM_IOP ) - call outfld('shflx ',cam_in%shf, pcols, lchnk) - call outfld('lhflx ',cam_in%lhf, pcols, lchnk) - call outfld('trefht ',cam_in%tref, pcols, lchnk) -#endif + if (write_camiop) then + call outfld('shflx ',cam_in%shf, pcols, lchnk) + call outfld('lhflx ',cam_in%lhf, pcols, lchnk) + call outfld('trefht ',cam_in%tref, pcols, lchnk) + call outfld('Tg', cam_in%ts, pcols, lchnk) + call outfld('Tsair',cam_in%ts, pcols, lchnk) + end if ! ! Ouput ocn and ice fractions ! @@ -2055,7 +2057,7 @@ subroutine diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt) ! Total physics tendency for Temperature ! (remove global fixer tendency from total for FV and SE dycores) - if (.not.dycore_is('EUL')) then + if (.not.dycore_is('EUL')) then call check_energy_get_integrals( heat_glob_out=heat_glob ) ftem2(:ncol) = heat_glob/cpair call outfld('TFIX', ftem2, pcols, lchnk ) 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..290d0022de 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -31,6 +31,8 @@ module check_energy use constituents, only: cnst_get_ind, pcnst, cnst_name, cnst_get_type_byind use time_manager, only: is_first_step use cam_logfile, only: iulog + use scamMod, only: single_column, use_camiop, heat_glob_scm + use cam_history, only: outfld, write_camiop implicit none private @@ -485,13 +487,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), & @@ -509,6 +512,7 @@ subroutine check_energy_gmean(state, pbuf2d, dtime, nstep) use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk use physics_types, only: dyn_te_idx + use cam_history, only: write_camiop !----------------------------------------------------------------------- ! Compute global mean total energy of physics input and output states ! computed consistently with dynamical core vertical coordinate @@ -587,8 +591,11 @@ subroutine check_energy_fix(state, ptend, nstep, eshflx) !---------------------------Local storage------------------------------- integer :: i ! column integer :: ncol ! number of atmospheric columns in chunk + integer :: lchnk ! chunk number + real(r8) :: heat_out(pcols) !----------------------------------------------------------------------- - ncol = state%ncol + lchnk = state%lchnk + ncol = state%ncol call physics_ptend_init(ptend, state%psetcols, 'chkenergyfix', ls=.true.) @@ -596,9 +603,22 @@ subroutine check_energy_fix(state, ptend, nstep, eshflx) ! disable the energy fix for offline driver heat_glob = 0._r8 #endif -! add (-) global mean total energy difference as heating + + ! Special handling of energy fix for SCAM - supplied via CAMIOP - zero's for normal IOPs + if (single_column) then + if ( use_camiop) then + heat_glob = heat_glob_scm(1) + else + heat_glob = 0._r8 + endif + endif ptend%s(:ncol,:pver) = heat_glob + if (nstep > 0 .and. write_camiop) then + heat_out(:ncol) = heat_glob + call outfld('heat_glob', heat_out(:ncol), pcols, lchnk) + endif + ! compute effective sensible heat flux do i = 1, ncol eshflx(i) = heat_glob * (state%pint(i,pver+1) - state%pint(i,1)) * rga @@ -942,10 +962,10 @@ subroutine tot_energy_phys(state, outfld_name_suffix,vc) ! 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_cnst = rga*rearth**3 mo_cnst = rga*omega*rearth**4 - + mr = 0.0_r8 mo = 0.0_r8 do k = 1, pver @@ -953,12 +973,12 @@ subroutine tot_energy_phys(state, outfld_name_suffix,vc) cos_lat = cos(state%lat(i)) mr_tmp = mr_cnst*state%u(i,k)*state%pdel(i,k)*cos_lat mo_tmp = mo_cnst*state%pdel(i,k)*cos_lat**2 - + mr(i) = mr(i) + mr_tmp mo(i) = mo(i) + mo_tmp end do end do - + call outfld(name_out(mridx) ,mr, pcols,lchnk ) call outfld(name_out(moidx) ,mo, pcols,lchnk ) diff --git a/src/physics/cam/chem_surfvals.F90 b/src/physics/cam/chem_surfvals.F90 index 812ddc8fcd..84af83b71a 100644 --- a/src/physics/cam/chem_surfvals.F90 +++ b/src/physics/cam/chem_surfvals.F90 @@ -512,6 +512,7 @@ subroutine chem_surfvals_set() use ppgrid, only: begchunk, endchunk use mo_flbc, only: flbc_gmean_vmr, flbc_chk + use scamMod, only: single_column, scmiop_flbc_inti, use_camiop !---------------------------Local variables----------------------------- @@ -527,7 +528,12 @@ subroutine chem_surfvals_set() elseif (scenario_ghg == 'CHEM_LBC_FILE') then ! set mixing ratios from cam-chem/waccm lbc file call flbc_chk() - call flbc_gmean_vmr(co2vmr,ch4vmr,n2ovmr,f11vmr,f12vmr) + if (single_column .and. use_camiop) then + call scmiop_flbc_inti( co2vmr, ch4vmr, n2ovmr, f11vmr, f12vmr ) + else + ! set by lower boundary conditions file + call flbc_gmean_vmr(co2vmr,ch4vmr,n2ovmr,f11vmr,f12vmr) + endif endif if (masterproc .and. is_end_curr_day()) then diff --git a/src/physics/cam/cloud_diagnostics.F90 b/src/physics/cam/cloud_diagnostics.F90 index f7a5115914..bd0f9b8e9d 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,13 +32,15 @@ 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 integer :: cldtau_idx = -1 integer :: nmxrgn_idx = -1 integer :: pmxrgn_idx = -1 + integer :: gb_totcldliqmr_idx = -1 + integer :: gb_totcldicemr_idx = -1 ! Index fields for precipitation efficiency. integer :: acpr_idx, acgcme_idx, acnum_idx @@ -82,15 +84,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 @@ -100,18 +105,28 @@ subroutine cloud_diagnostics_init() !----------------------------------------------------------------------- cld_idx = pbuf_get_index('CLD') + ! grid box total cloud liquid water mixing ratio (kg/kg) + gb_totcldliqmr_idx = pbuf_get_index('GB_TOTCLDLIQMR') + ! grid box total cloud ice water mixing ratio (kg/kg) + gb_totcldicemr_idx = pbuf_get_index('GB_TOTCLDICEMR') call phys_getopts(use_spcam_out=use_spcam) 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 +151,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 +172,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 +223,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 @@ -245,6 +260,9 @@ subroutine cloud_diagnostics_calc(state, pbuf) integer, pointer :: nmxrgn(:) ! Number of maximally overlapped regions real(r8), pointer :: pmxrgn(:,:) ! Maximum values of pressure for each + real(r8), pointer :: totg_ice(:,:) ! grid box total cloud ice mixing ratio + real(r8), pointer :: totg_liq(:,:) ! grid box total cloud liquid mixing ratio + integer :: itim_old real(r8) :: cwp (pcols,pver) ! in-cloud cloud (total) water path @@ -277,7 +295,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 @@ -297,6 +315,9 @@ subroutine cloud_diagnostics_calc(state, pbuf) itim_old = pbuf_old_tim_idx() call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, gb_totcldicemr_idx, totg_ice) + call pbuf_get_field(pbuf, gb_totcldliqmr_idx, totg_liq) + if(two_mom_clouds)then call pbuf_get_field(pbuf, iclwp_idx, iclwp ) @@ -362,10 +383,9 @@ subroutine cloud_diagnostics_calc(state, pbuf) ! iclwp and iciwp to pass to the radiation. ! ! ----------------------------------------------------------- ! 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) + call conv_water_4rad(state, pbuf) + allcld_ice(:ncol,:) = totg_ice(:ncol,:) ! Grid-avg all cloud liquid + allcld_liq(:ncol,:) = totg_liq(:ncol,:) ! Grid-avg all cloud ice else allcld_liq(:ncol,top_lev:pver) = state%q(:ncol,top_lev:pver,ixcldliq) ! Grid-ave all cloud liquid allcld_ice(:ncol,top_lev:pver) = state%q(:ncol,top_lev:pver,ixcldice) ! " ice @@ -410,12 +430,14 @@ subroutine cloud_diagnostics_calc(state, pbuf) elseif(one_mom_clouds) then if (conv_water_in_rad /= 0) then - call conv_water_4rad(state, pbuf, allcld_liq, allcld_ice) + call conv_water_4rad(state, pbuf) + allcld_ice(:ncol,:) = totg_ice(:ncol,:) ! Grid-avg all cloud liquid + allcld_liq(:ncol,:) = totg_liq(:ncol,:) ! Grid-avg all cloud ice else 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 +458,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 +475,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 +503,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 +527,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..8370801d34 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,36 @@ 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 + use scamMOD, only: single_column,scm_clubb_iop_name,scm_cambfb_mode 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 +71,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 +87,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 +209,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 +221,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 +325,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 +341,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 +431,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 +518,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 +528,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 +610,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 +757,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 +776,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 +821,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 +847,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 +855,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 +887,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 +950,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 +1090,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 +1136,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 +1191,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 +1209,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 +1225,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 +1312,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 +1330,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 +1375,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 +1385,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 +1424,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 +1441,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 +1477,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 +1500,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 +1515,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 +1579,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 +1605,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 +1650,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 +1676,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 +1762,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 +1869,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 +2052,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,9 +2111,9 @@ 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 use clubb_api_module, only: & nparams, & setup_parameters_api, & @@ -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,13 +2599,13 @@ 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") nlev = pver + 1 - top_lev + call t_startf('clubb_tend_cam:NAR') rtp2_zt_out = 0._r8 thl2_zt_out = 0._r8 wp2_zt_out = 0._r8 @@ -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) ) @@ -2583,16 +2778,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Define the grid box size. CLUBB needs this information to determine what ! the maximum length scale should be. This depends on the column for ! variable mesh grids and lat-lon grids - if (single_column) then - ! If single column specify grid box size to be something - ! similar to a GCM run - grid_dx(:) = 100000._r8 - grid_dy(:) = 100000._r8 - else - - call grid_size(state1, grid_dx, grid_dy) - end if + call grid_size(state1, grid_dx, grid_dy) + call t_stopf('clubb_tend_cam:NAR') if (clubb_do_icesuper) then @@ -2614,11 +2802,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & qitend(:ncol,:)=0._r8 initend(:ncol,:)=0._r8 + call t_startf('clubb_tend_cam:ice_macro_tend') call ice_macro_tend(naai(1:ncol,top_lev:pver), state1%t(1:ncol,top_lev:pver), & state1%pmid(1:ncol,top_lev:pver), state1%q(1:ncol,top_lev:pver,1), & state1%q(1:ncol,top_lev:pver,ixcldice), state1%q(1:ncol,top_lev:pver,ixnumice), & latsub, hdtime, stend(1:ncol,top_lev:pver), qvtend(1:ncol,top_lev:pver), & qitend(1:ncol,top_lev:pver), initend(1:ncol,top_lev:pver), ncol*(pver-top_lev+1)) + call t_stopf('clubb_tend_cam:ice_macro_tend') ! update local copy of state with the tendencies ptend_loc%q(:ncol,top_lev:pver,1)=qvtend(:ncol,top_lev:pver) @@ -2640,6 +2830,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'NITENDICE', initend, pcols, lchnk ) endif + call t_startf('clubb_tend_cam:NAR') ! Determine CLUBB time step and make it sub-step friendly @@ -2801,7 +2992,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_qtflx_output(:,:) = 0._r8 end if - call t_startf("clubb_tend_cam_i_loop") ! Determine Coriolis force at given latitude. This is never used ! when CLUBB is implemented in a host model, therefore just set @@ -2891,7 +3081,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! This section of code block is NOT called in ! ! global simulations ! ! ------------------------------------------------- ! - if (single_column) then + if (single_column .and. .not. scm_cambfb_mode) then ! Initialize zo if variable ustar is used if (cam_in%landfrac(1) >= 0.5_r8) then @@ -2945,11 +3135,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 +3151,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) - 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) + do i = 1, ncol + clubb_params(i,:) = clubb_params_single_col(:) + end do + + 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 @@ -3041,7 +3234,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Perturbed winds are not used in CAM upwp_sfc_pert = 0.0_r8 vpwp_sfc_pert = 0.0_r8 + call t_stopf('clubb_tend_cam:NAR') + call t_startf('clubb_tend_cam:flip-index') ! Need to flip arrays around for CLUBB core do k=1,nlev+1 do i=1,ncol @@ -3249,18 +3444,27 @@ 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 + call t_stopf('clubb_tend_cam:flip-index') 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 !####################################################################### !###################### CALL MF DIAGNOSTIC PLUMES ###################### !####################################################################### if (do_clubb_mf) then + call t_startf('clubb_tend_cam:do_clubb_mf') do k=2,pverp do i=1, ncol @@ -3282,18 +3486,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 @@ -3311,12 +3515,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ((rho_ds_zm(i,k) * mf_thlflx(i,k)) - (rho_ds_zm(i,k-1) * mf_thlflx(i,k-1))) end do end do + call t_stopf('clubb_tend_cam:do_clubb_mf') end if ! Advance CLUBB CORE one timestep in the future + call t_startf('clubb_tend_cam:advance_clubb_core_api') 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 +3535,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, & @@ -3355,13 +3565,19 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wprcp_out, w_up_in_cloud_out, w_down_in_cloud_out, & cloudy_updraft_frac_out, cloudy_downdraft_frac_out, & rcm_in_layer_out, cloud_cover_out, invrs_tau_zm_out ) + call t_stopf('clubb_tend_cam:advance_clubb_core_api') ! Note that CLUBB does not produce an error code specific to any column, and ! 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 @@ -3373,12 +3589,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do + call t_startf('clubb_tend_cam:update_xp2_mc_api') call update_xp2_mc_api( gr, nlev+1, ncol, dtime, cloud_frac_inout, & rcm_inout, rvm_in, thlm_in, wm_zt, & exner, pre_in, pdf_params_chnk(lchnk), & rtp2_mc_out, thlp2_mc_out, & wprtp_mc_out, wpthlp_mc_out, & rtpthlp_mc_out) + call t_stopf('clubb_tend_cam:update_xp2_mc_api') do k=1,nlev+1 do i=1,ncol @@ -3396,13 +3614,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (do_cldcool) then + call t_startf('clubb_tend_cam:do_cldcool') rcm_out_zm = zt2zm_api(pverp+1-top_lev, ncol, gr, rcm_inout ) qrl_zm = zt2zm_api(pverp+1-top_lev, ncol, gr, qrl_clubb ) 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 @@ -3410,19 +3629,23 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & thlp2_in(i,:) = thlp2_in(i,:) + thlp2_rad_out(i,:) * dtime thlp2_in(i,:) = max(thl_tol**2,thlp2_in(i,:)) end do + call t_stopf('clubb_tend_cam:do_cldcool') end if ! 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 + call t_startf('clubb_tend_cam:stats_end_timestep_clubb') 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) end do + call t_stopf('clubb_tend_cam:stats_end_timestep_clubb') end if enddo ! end time loop + call t_startf('clubb_tend_cam:NAR') if (clubb_do_adv) then if (macmic_it == cld_macmic_num_steps) then @@ -3448,12 +3671,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if end if + call t_stopf('clubb_tend_cam:NAR') ! Convert RTP2 and THLP2 to thermo grid for output + call t_startf('clubb_tend_cam:NAR') rtp2_zt = zm2zt_api( pverp+1-top_lev, ncol, gr, rtp2_in ) thl2_zt = zm2zt_api( pverp+1-top_lev, ncol, gr, thlp2_in ) wp2_zt = zm2zt_api( pverp+1-top_lev, ncol, gr, wp2_in ) + call t_stopf('clubb_tend_cam:NAR') + call t_startf('clubb_tend_cam:flip-index') ! Arrays need to be "flipped" to CAM grid do k=1, nlev+1 do i=1, ncol @@ -3513,6 +3740,22 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do + call t_stopf('clubb_tend_cam:flip-index') + call t_startf('clubb_tend_cam:NAR') + + ! 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 +3942,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 @@ -3782,7 +4041,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if end do - call t_stopf("clubb_tend_cam_i_loop") call outfld('KVH_CLUBB', khzm, pcols, lchnk) @@ -3829,9 +4087,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! then advances it's predictive equations second, this can lead to ! RHliq > 1 directly before microphysics is called. Therefore, we use ! ice_macro_tend to enforce RHliq <= 1 everywhere before microphysics is called. + call t_stopf('clubb_tend_cam:NAR') if (clubb_do_liqsupersat) then + call t_startf('clubb_cam_tend:do_liqsupersat') ! -------------------------------------- ! ! Ice Saturation Adjustment Computation ! ! -------------------------------------- ! @@ -3883,7 +4143,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end where call outfld( 'FQTENDICE', fqtend, pcols, lchnk ) + call t_stopf('clubb_cam_tend:do_liqsupersat') end if + call t_startf('clubb_tend_cam:NAR') ! ------------------------------------------------------------ ! ! The rest of the code deals with diagnosing variables ! @@ -4083,7 +4345,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & enddo enddo - if (single_column) then + if (single_column .and. .not. scm_cambfb_mode) then if (trim(scm_clubb_iop_name) == 'ATEX_48hr' .or. & trim(scm_clubb_iop_name) == 'BOMEX_5day' .or. & trim(scm_clubb_iop_name) == 'DYCOMSrf01_4day' .or. & @@ -4273,7 +4535,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 +4555,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 @@ -4308,8 +4570,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & enddo endif - - call t_stopf("clubb_tend_cam") + call t_stopf('clubb_tend_cam:NAR') + return #endif @@ -4523,57 +4785,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 +4800,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 +4814,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 +4842,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 +4901,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 +5128,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 +5208,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 +5237,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 +5245,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 +5270,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 +5303,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/conv_water.F90 b/src/physics/cam/conv_water.F90 index dfcdb7be98..d848895366 100644 --- a/src/physics/cam/conv_water.F90 +++ b/src/physics/cam/conv_water.F90 @@ -3,7 +3,7 @@ module conv_water ! --------------------------------------------------------------------- ! ! Purpose: ! ! Computes grid-box average liquid (and ice) from stratus and cumulus ! - ! Just for the purposes of radiation. ! + ! These values used by both the radiation and the COSP diagnostics. ! ! ! ! Method: ! ! Extract information about deep+shallow liquid and cloud fraction from ! @@ -38,9 +38,10 @@ module conv_water ! pbuf indices integer :: icwmrsh_idx, icwmrdp_idx, fice_idx, sh_frac_idx, dp_frac_idx, & - ast_idx, sh_cldliq1_idx, sh_cldice1_idx, rei_idx + ast_idx, rei_idx integer :: ixcldice, ixcldliq + integer :: gb_totcldliqmr_idx, gb_totcldicemr_idx ! Namelist integer, parameter :: unset_int = huge(1) @@ -113,11 +114,10 @@ subroutine conv_water_register !----------------------------------------------------------------------- - ! these calls were already done in convect_shallow...so here I add the same fields to the physics buffer with a "1" at the end -! shallow gbm cloud liquid water (kg/kg) - call pbuf_add_field('SH_CLDLIQ1','physpkg',dtype_r8,(/pcols,pver/),sh_cldliq1_idx) -! shallow gbm cloud ice water (kg/kg) - call pbuf_add_field('SH_CLDICE1','physpkg',dtype_r8,(/pcols,pver/),sh_cldice1_idx) + ! grid box total cloud liquid water mixing ratio (kg/kg) + call pbuf_add_field('GB_TOTCLDLIQMR', 'physpkg', dtype_r8, (/pcols,pver/), gb_totcldliqmr_idx) + ! grid box total cloud ice water mixing ratio (kg/kg) + call pbuf_add_field('GB_TOTCLDICEMR', 'physpkg', dtype_r8, (/pcols,pver/), gb_totcldicemr_idx) end subroutine conv_water_register @@ -168,7 +168,7 @@ subroutine conv_water_init() end subroutine conv_water_init - subroutine conv_water_4rad(state, pbuf, totg_liq, totg_ice) + subroutine conv_water_4rad(state, pbuf) ! --------------------------------------------------------------------- ! ! Purpose: ! @@ -202,9 +202,6 @@ subroutine conv_water_4rad(state, pbuf, totg_liq, totg_ice) type(physics_state), target, intent(in) :: state ! state variables type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(out):: totg_ice(pcols,pver) ! Total GBA in-cloud ice - real(r8), intent(out):: totg_liq(pcols,pver) ! Total GBA in-cloud liquid - ! --------------- ! ! Local Workspace ! ! --------------- ! @@ -222,8 +219,9 @@ subroutine conv_water_4rad(state, pbuf, totg_liq, totg_ice) real(r8), pointer, dimension(:,:) :: dp_icwmr ! Deep conv. cloud water real(r8), pointer, dimension(:,:) :: sh_icwmr ! Shallow conv. cloud water real(r8), pointer, dimension(:,:) :: fice ! Ice partitioning ratio - real(r8), pointer, dimension(:,:) :: sh_cldliq ! shallow convection gbx liq cld mixing ratio for COSP - real(r8), pointer, dimension(:,:) :: sh_cldice ! shallow convection gbx ice cld mixing ratio for COSP + + real(r8), pointer, dimension(:,:) :: totg_ice ! Grid box total cloud ice mixing ratio + real(r8), pointer, dimension(:,:) :: totg_liq ! Grid box total cloud liquid mixing ratio real(r8) :: conv_ice(pcols,pver) ! Convective contributions to IC cloud ice real(r8) :: conv_liq(pcols,pver) ! Convective contributions to IC cloud liquid @@ -282,6 +280,10 @@ subroutine conv_water_4rad(state, pbuf, totg_liq, totg_ice) itim_old = pbuf_old_tim_idx() call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + ! Fields computed below and stored in pbuf. + call pbuf_get_field(pbuf, gb_totcldicemr_idx, totg_ice) + call pbuf_get_field(pbuf, gb_totcldliqmr_idx, totg_liq) + ! --------------------------------------------------------------- ! ! Loop through grid-boxes and determine: ! ! 1. Effective mean in-cloud convective ice/liquid (deep+shallow) ! @@ -407,13 +409,6 @@ subroutine conv_water_4rad(state, pbuf, totg_liq, totg_ice) end do end do -!add pbuff calls for COSP - call pbuf_get_field(pbuf, sh_cldliq1_idx, sh_cldliq ) - call pbuf_get_field(pbuf, sh_cldice1_idx, sh_cldice ) - - sh_cldliq(:ncol,:pver)=sh_icwmr(:ncol,:pver)*(1-fice(:ncol,:pver))*sh_frac(:ncol,:pver) - sh_cldice(:ncol,:pver)=sh_icwmr(:ncol,:pver)*fice(:ncol,:pver)*sh_frac(:ncol,:pver) - ! Output convective IC WMRs call outfld( 'ICLMRCU ', conv_liq , pcols, lchnk ) 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/convect_shallow.F90 b/src/physics/cam/convect_shallow.F90 index ffd1db8f5f..902187eb24 100644 --- a/src/physics/cam/convect_shallow.F90 +++ b/src/physics/cam/convect_shallow.F90 @@ -215,6 +215,7 @@ subroutine convect_shallow_init(pref_edge, pbuf2d) call addfld( 'CMFMC', (/ 'ilev' /), 'A', 'kg/m2/s', 'Moist convection (deep+shallow) mass flux' ) call addfld( 'CMFSL', (/ 'ilev' /), 'A', 'W/m2', 'Moist shallow convection liquid water static energy flux' ) call addfld( 'CMFLQ', (/ 'ilev' /), 'A', 'W/m2', 'Moist shallow convection total water flux' ) + call addfld ('DQP', (/ 'lev' /), 'A', 'kg/kg/s', 'Specific humidity tendency due to precipitation' ) call addfld( 'CBMF', horiz_only, 'A', 'kg/m2/s', 'Cloud base mass flux' ) call addfld( 'CLDTOP', horiz_only, 'I', '1', 'Vertical index of cloud top' ) call addfld( 'CLDBOT', horiz_only, 'I', '1', 'Vertical index of cloud base' ) @@ -249,7 +250,7 @@ subroutine convect_shallow_init(pref_edge, pbuf2d) call add_default( 'CMFDICE ', history_budget_histfile_num, ' ' ) call add_default( 'CMFDT ', history_budget_histfile_num, ' ' ) call add_default( 'CMFDQ ', history_budget_histfile_num, ' ' ) - if( cam_physpkg_is('cam3') .or. cam_physpkg_is('cam4') ) then + if( cam_physpkg_is('cam4') ) then call add_default( 'EVAPQCM ', history_budget_histfile_num, ' ' ) call add_default( 'EVAPTCM ', history_budget_histfile_num, ' ' ) end if diff --git a/src/physics/cam/cospsimulator_intr.F90 b/src/physics/cam/cospsimulator_intr.F90 index 6a01415f04..7e81e61053 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. @@ -219,8 +212,9 @@ module cospsimulator_intr ! chunk (allocatable->1:pcols,begchunk:endchunk) ! pbuf indices integer :: cld_idx, concld_idx, lsreffrain_idx, lsreffsnow_idx, cvreffliq_idx - integer :: cvreffice_idx, dpcldliq_idx, dpcldice_idx - integer :: shcldliq1_idx, shcldice1_idx, dpflxprc_idx + integer :: cvreffice_idx + integer :: gb_totcldliqmr_idx, gb_totcldicemr_idx + integer :: dpflxprc_idx integer :: dpflxsnw_idx, shflxprc_idx, shflxsnw_idx, lsflxprc_idx, lsflxsnw_idx integer :: rei_idx, rel_idx @@ -268,188 +262,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 +404,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 +422,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 +435,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 +470,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 +487,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 +521,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') @@ -1162,10 +871,8 @@ subroutine cospsimulator_intr_init() lsreffsnow_idx = pbuf_get_index('LS_REFFSNOW') cvreffliq_idx = pbuf_get_index('CV_REFFLIQ') cvreffice_idx = pbuf_get_index('CV_REFFICE') - dpcldliq_idx = pbuf_get_index('DP_CLDLIQ') - dpcldice_idx = pbuf_get_index('DP_CLDICE') - shcldliq1_idx = pbuf_get_index('SH_CLDLIQ1') - shcldice1_idx = pbuf_get_index('SH_CLDICE1') + gb_totcldliqmr_idx = pbuf_get_index('GB_TOTCLDLIQMR') ! grid box total cloud liquid water mr (kg/kg) + gb_totcldicemr_idx = pbuf_get_index('GB_TOTCLDICEMR') ! grid box total cloud ice water mr (kg/kg) dpflxprc_idx = pbuf_get_index('DP_FLXPRC') dpflxsnw_idx = pbuf_get_index('DP_FLXSNW') shflxprc_idx = pbuf_get_index('SH_FLXPRC', errcode=ierr) @@ -1173,31 +880,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 +1080,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 +1101,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 +1149,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 +1158,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 +1176,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 +1184,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 +1195,68 @@ 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) + !! grid box total cloud mixing ratio (large-scale + convective) + real(r8), pointer, dimension(:,:) :: totg_liq ! gbm total cloud liquid water (kg/kg) + real(r8), pointer, dimension(:,:) :: totg_ice ! gbm total 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 +1268,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 +1297,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 +1528,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 - - !! 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 - !! 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 + + !! 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 - 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) - - !! 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 + if (snow_ls_interp(i,k) < 0._r8) then + snow_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 + if (rain_cv_interp(i,k) < 0._r8) then + rain_cv_interp(i,k) = 0._r8 end if - if (rain_cv_interp(i,k) .lt. 0._r8) then - rain_cv_interp(i,k)=0._r8 + if (snow_cv_interp(i,k) < 0._r8) then + snow_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 do + end do + + grpl_ls_interp = 0._r8 + + ! subroutine subsample_and_optics provides separate arguments to pass + ! the large scale and convective cloud condensate. Below the grid box + ! total cloud water mixing ratios are passed in the arrays for the + ! large scale contributions and the arrays for the convective + ! contributions are set to zero. This is consistent with the treatment + ! of cloud water by the radiation code. + 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 + mr_lsliq(i,k) = totg_liq(i,kk) + mr_lsice(i,k) = totg_ice(i,kk) 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 + !! 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 + + ! 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 +1663,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 +1686,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 +1761,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 +1877,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 +1903,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 +1979,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 +2021,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 +2042,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 +2175,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 +2334,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 +2352,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 +2390,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 +2408,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 +2418,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 +2428,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 +2483,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 +2543,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 +2558,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 +2614,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 +2629,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 +2653,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 +2663,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 +2751,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 +2808,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 +2840,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 +2855,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 +2893,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/dadadj.F90 b/src/physics/cam/dadadj.F90 deleted file mode 100644 index b9762f8f5f..0000000000 --- a/src/physics/cam/dadadj.F90 +++ /dev/null @@ -1,174 +0,0 @@ -module dadadj -!----------------------------------------------------------------------- -! -! Purpose: -! GFDL style dry adiabatic adjustment -! -! Method: -! if stratification is unstable, adjustment to the dry adiabatic lapse -! rate is forced subject to the condition that enthalpy is conserved. -! -! Author: J.Hack -! -!----------------------------------------------------------------------- - -use shr_kind_mod, only: r8 => shr_kind_r8 - -implicit none -private -save - -public :: & - dadadj_initial, & - dadadj_calc - -integer :: nlvdry ! number of layers from top of model to apply the adjustment -integer :: niter ! number of iterations for convergence - -!=============================================================================== -contains -!=============================================================================== - -subroutine dadadj_initial(nlvdry_in, niter_in) - - integer, intent(in) :: nlvdry_in - integer, intent(in) :: niter_in - - nlvdry = nlvdry_in - niter = niter_in - -end subroutine dadadj_initial - -!=============================================================================== - -subroutine dadadj_calc( & - ncol, pmid, pint, pdel, cappav, t, & - q, dadpdf, icol_err) - - ! Arguments - - integer, intent(in) :: ncol ! number of atmospheric columns - - real(r8), intent(in) :: pmid(:,:) ! pressure at model levels - real(r8), intent(in) :: pint(:,:) ! pressure at model interfaces - real(r8), intent(in) :: pdel(:,:) ! vertical delta-p - real(r8), intent(in) :: cappav(:,:) ! variable Kappa - - real(r8), intent(inout) :: t(:,:) ! temperature (K) - real(r8), intent(inout) :: q(:,:) ! specific humidity - - real(r8), intent(out) :: dadpdf(:,:) ! PDF of where adjustments happened - - integer, intent(out) :: icol_err ! index of column in which error occurred - - !---------------------------Local workspace----------------------------- - - integer :: i,k ! longitude, level indices - integer :: jiter ! iteration index - - real(r8), allocatable :: c1dad(:) ! intermediate constant - real(r8), allocatable :: c2dad(:) ! intermediate constant - real(r8), allocatable :: c3dad(:) ! intermediate constant - real(r8), allocatable :: c4dad(:) ! intermediate constant - real(r8) :: gammad ! dry adiabatic lapse rate (deg/Pa) - real(r8) :: zeps ! convergence criterion (deg/Pa) - real(r8) :: rdenom ! reciprocal of denominator of expression - real(r8) :: dtdp ! delta-t/delta-p - real(r8) :: zepsdp ! zeps*delta-p - real(r8) :: zgamma ! intermediate constant - real(r8) :: qave ! mean q between levels - real(r8) :: cappa ! Kappa at level intefaces - - logical :: ilconv ! .TRUE. ==> convergence was attained - logical :: dodad(ncol) ! .TRUE. ==> do dry adjustment - - !----------------------------------------------------------------------- - - icol_err = 0 - zeps = 2.0e-5_r8 ! set convergence criteria - - allocate(c1dad(nlvdry), c2dad(nlvdry), c3dad(nlvdry), c4dad(nlvdry)) - - ! Find gridpoints with unstable stratification - - do i = 1, ncol - cappa = 0.5_r8*(cappav(i,2) + cappav(i,1)) - gammad = cappa*0.5_r8*(t(i,2) + t(i,1))/pint(i,2) - dtdp = (t(i,2) - t(i,1))/(pmid(i,2) - pmid(i,1)) - dodad(i) = (dtdp + zeps) .gt. gammad - end do - - dadpdf(:ncol,:) = 0._r8 - do k= 2, nlvdry - do i = 1, ncol - cappa = 0.5_r8*(cappav(i,k+1) + cappav(i,k)) - gammad = cappa*0.5_r8*(t(i,k+1) + t(i,k))/pint(i,k+1) - dtdp = (t(i,k+1) - t(i,k))/(pmid(i,k+1) - pmid(i,k)) - dodad(i) = dodad(i) .or. (dtdp + zeps).gt.gammad - if ((dtdp + zeps).gt.gammad) then - dadpdf(i,k) = 1._r8 - end if - end do - end do - - ! Make a dry adiabatic adjustment - ! Note: nlvdry ****MUST**** be < pver - - COL: do i = 1, ncol - - if (dodad(i)) then - - zeps = 2.0e-5_r8 - - do k = 1, nlvdry - c1dad(k) = cappa*0.5_r8*(pmid(i,k+1)-pmid(i,k))/pint(i,k+1) - c2dad(k) = (1._r8 - c1dad(k))/(1._r8 + c1dad(k)) - rdenom = 1._r8/(pdel(i,k)*c2dad(k) + pdel(i,k+1)) - c3dad(k) = rdenom*pdel(i,k) - c4dad(k) = rdenom*pdel(i,k+1) - end do - -50 continue - - do jiter = 1, niter - ilconv = .true. - - do k = 1, nlvdry - zepsdp = zeps*(pmid(i,k+1) - pmid(i,k)) - zgamma = c1dad(k)*(t(i,k) + t(i,k+1)) - - if ((t(i,k+1)-t(i,k)) >= (zgamma+zepsdp)) then - ilconv = .false. - t(i,k+1) = t(i,k)*c3dad(k) + t(i,k+1)*c4dad(k) - t(i,k) = c2dad(k)*t(i,k+1) - qave = (pdel(i,k+1)*q(i,k+1) + pdel(i,k)*q(i,k))/(pdel(i,k+1)+ pdel(i,k)) - q(i,k+1) = qave - q(i,k) = qave - end if - - end do - - if (ilconv) cycle COL ! convergence => next longitude - end do - - ! Double convergence criterion if no convergence in niter iterations - - zeps = zeps + zeps - if (zeps > 1.e-4_r8) then - icol_err = i - return ! error return - else - go to 50 - end if - - end if - - end do COL - - deallocate(c1dad, c2dad, c3dad, c4dad) - -end subroutine dadadj_calc - -!=============================================================================== - -end module dadadj diff --git a/src/physics/cam/dadadj_cam.F90 b/src/physics/cam/dadadj_cam.F90 index 0717865ca8..c2a6d685d1 100644 --- a/src/physics/cam/dadadj_cam.F90 +++ b/src/physics/cam/dadadj_cam.F90 @@ -2,7 +2,7 @@ module dadadj_cam ! CAM interfaces for the dry adiabatic adjustment parameterization -use shr_kind_mod, only: r8=>shr_kind_r8, cs=>shr_kind_cs +use shr_kind_mod, only: r8=>shr_kind_r8, cs=>shr_kind_cs, cm=>shr_kind_cm use ppgrid, only: pcols, pver, pverp use constituents, only: pcnst use air_composition, only: cappav, cpairv @@ -17,7 +17,7 @@ module dadadj_cam use namelist_utils, only: find_group_name use units, only: getunit, freeunit -use dadadj, only: dadadj_initial, dadadj_calc +use dadadj, only: dadadj_init, dadadj_run implicit none private @@ -25,7 +25,7 @@ module dadadj_cam public :: & dadadj_readnl, & - dadadj_init, & + dadadj_cam_init, & dadadj_tend ! Namelist variables @@ -42,8 +42,10 @@ subroutine dadadj_readnl(filein) namelist /dadadj_nl/ dadadj_nlvdry, dadadj_niter - integer :: unitn, ierr - character(len=*), parameter :: sub='dadadj_readnl' + integer :: unitn, ierr + integer :: errflg ! CCPP physics scheme error flag + character(len=512) :: errmsg ! CCPP physics scheme error message + character(len=*), parameter :: sub='dadadj_readnl' !------------------------------------------------------------------ ! Read namelist @@ -67,13 +69,16 @@ subroutine dadadj_readnl(filein) call mpibcast(dadadj_niter, 1, mpi_integer, masterprocid, mpicom) #endif - call dadadj_initial(dadadj_nlvdry, dadadj_niter) + call dadadj_init(dadadj_nlvdry, dadadj_niter, pver, errmsg, errflg) + if (errflg /=0) then + call endrun('dadadj_readnl: Error returned from dadadj_init: '//trim(errmsg)) + end if if (masterproc .and. .not. use_simple_phys) then write(iulog,*)'Dry adiabatic adjustment applied to top N layers; N=', & - dadadj_nlvdry + dadadj_nlvdry write(iulog,*)'Dry adiabatic adjustment number of iterations for convergence =', & - dadadj_niter + dadadj_niter end if end subroutine dadadj_readnl @@ -81,12 +86,12 @@ end subroutine dadadj_readnl !=============================================================================== -subroutine dadadj_init() +subroutine dadadj_cam_init() use cam_history, only: addfld call addfld('DADADJ_PD', (/ 'lev' /), 'A', 'probability', 'dry adiabatic adjustment probability') -end subroutine dadadj_init +end subroutine dadadj_cam_init !=============================================================================== @@ -98,39 +103,49 @@ subroutine dadadj_tend(dt, state, ptend) type(physics_state), intent(in) :: state ! Physics state variables type(physics_ptend), intent(out) :: ptend ! parameterization tendencies - logical :: lq(pcnst) - real(r8) :: dadpdf(pcols, pver) - integer :: ncol, lchnk, icol_err - character(len=128) :: errstring ! Error string - - ncol = state%ncol - lchnk = state%lchnk - lq(:) = .FALSE. - lq(1) = .TRUE. - call physics_ptend_init(ptend, state%psetcols, 'dadadj', ls=.true., lq=lq) - - ! use the ptend components for temporary storate and copy state info for input to - ! dadadj_calc which directly updates the temperature and moisture input arrays. - - ptend%s(:ncol,:pver) = state%t(:ncol,:pver) - ptend%q(:ncol,:pver,1) = state%q(:ncol,:pver,1) - - call dadadj_calc( & - ncol, state%pmid, state%pint, state%pdel, cappav(:,:,lchnk), ptend%s, & - ptend%q(:,:,1), dadpdf, icol_err) - - call outfld('DADADJ_PD', dadpdf(:ncol,:), ncol, lchnk) - - if (icol_err > 0) then - ! error exit - write(errstring, *) & - 'dadadj_calc: No convergence in column at lat,lon:', & - state%lat(icol_err)*180._r8/pi, state%lon(icol_err)*180._r8/pi - call handle_errmsg(errstring, subname="dadadj_tend") - end if - - ptend%s(:ncol,:) = (ptend%s(:ncol,:) - state%t(:ncol,:) )/dt * cpairv(:ncol,:,lchnk) - ptend%q(:ncol,:,1) = (ptend%q(:ncol,:,1) - state%q(:ncol,:,1))/dt + character(len=512) :: errstring ! Error string + character(len=512) :: errmsg ! CCPP physics scheme error message + character(len=64) :: scheme_name! CCPP physics scheme name (not used in CAM) + integer :: icol_err + integer :: lchnk + integer :: ncol + integer :: errflg ! CCPP physics scheme error flag + logical :: lq(pcnst) + real(r8) :: dadpdf(pcols, pver) + + !------------------------------------------------------------------ + ncol = state%ncol + lchnk = state%lchnk + lq(:) = .FALSE. + lq(1) = .TRUE. + call physics_ptend_init(ptend, state%psetcols, 'dadadj', ls=.true., lq=lq) + + !REMOVECAM - no longer need these when CAM is retired and pcols no longer exists + dadpdf = 0._r8 + ptend%s = 0._r8 + ptend%q = 0._r8 + !REMOVECAM_END + + ! dadadj_run returns t tend, we are passing the ptend%s array to receive the t tendency and will convert it to s + ! before it is returned to CAM.. + call dadadj_run( & + ncol, pver, dt, state%pmid(:ncol,:), state%pint(:ncol,:), state%pdel(:ncol,:), & + state%t(:ncol,:), state%q(:ncol,:,1), cappav(:ncol,:,lchnk), cpairv(:ncol,:,lchnk), ptend%s(:ncol,:), & + ptend%q(:ncol,:,1), dadpdf(:ncol,:), scheme_name, errmsg, errflg) + + ! error exit + if (errflg /= 0) then + ! If this is a Convergence error then output lat lon of problem column using column index (errflg) + if(index('Convergence', errmsg) /= 0)then + write(errstring, *) trim(adjustl(errmsg)),' lat:',state%lat(errflg)*180._r8/pi,' lon:', & + state%lon(errflg)*180._r8/pi + else + errstring=trim(errmsg) + end if + call endrun('Error dadadj_tend:'//trim(errstring)) + end if + + call outfld('DADADJ_PD', dadpdf(:ncol,:), ncol, lchnk) end subroutine dadadj_tend diff --git a/src/physics/cam/eddy_diff.F90 b/src/physics/cam/eddy_diff.F90 index de50778cbd..b48e7ed137 100644 --- a/src/physics/cam/eddy_diff.F90 +++ b/src/physics/cam/eddy_diff.F90 @@ -632,7 +632,7 @@ subroutine caleddy( pcols , pver , ncol , kvh_in , kvm_in , kvh , kvm , & tpert , qpert , qrlin , kvf , tke , & wstarent , bprod , sprod , minpblh , wpert , & - tkes , went , turbtype , sm_aw , & + tkes , went , turbtype , & kbase_o , ktop_o , ncvfin_o , & kbase_mg , ktop_mg , ncvfin_mg , & kbase_f , ktop_f , ncvfin_f , & @@ -752,8 +752,6 @@ subroutine caleddy( pcols , pver , ncol , ! 3. = Bottom external interface of CL ! 4. = Top external interface of CL. ! 5. = Double entraining CL external interface - real(r8), intent(out) :: sm_aw(pcols,pver+1) ! Galperin instability function of momentum for use in the microphysics - ! [ no unit ] integer(i4), intent(out) :: ipbl(pcols) ! If 1, PBL is CL, while if 0, PBL is STL. integer(i4), intent(out) :: kpblh(pcols) ! Layer index containing PBL within or at the base interface real(r8), intent(out) :: wsed_CL(pcols,ncvmax) ! Sedimentation velocity at the top of each CL [ m/s ] @@ -1002,7 +1000,6 @@ subroutine caleddy( pcols , pver , ncol , sh_a(i,:pver+1) = 0._r8 sm_a(i,:pver+1) = 0._r8 ri_a(i,:pver+1) = 0._r8 - sm_aw(i,:pver+1) = 0._r8 ipbl(i) = 0 kpblh(i) = pver wsed_CL(i,:ncvmax) = 0._r8 @@ -1844,7 +1841,6 @@ subroutine caleddy( pcols , pver , ncol , bprod(i,k) = -kvh(i,k) * n2(i,k) sprod(i,k) = kvm(i,k) * s2(i,k) turbtype(i,k) = 2 ! CL interior interfaces. - sm_aw(i,k) = smcl(i,ncv)/alph1 ! Diagnostic output for microphysics end do ! 2. At CL top entrainment interface @@ -1860,7 +1856,6 @@ subroutine caleddy( pcols , pver , ncol , rcap = min( max(rcap,rcapmin), rcapmax ) tke(i,kt) = ebrk(i,ncv) * rcap tke(i,kt) = min( tke(i,kt), tkemax ) - sm_aw(i,kt) = smcl(i,ncv) / alph1 ! Diagnostic output for microphysics ! 3. At CL base entrainment interface and double entraining interfaces ! When current CL base is also the top interface of CL regime below, @@ -1921,12 +1916,6 @@ subroutine caleddy( pcols , pver , ncol , end if - ! For double entraining interface, simply use smcl(i,ncv) of the overlying CL. - ! Below 'sm_aw' is a diagnostic output for use in the microphysics. - ! When 'kb' is surface, 'sm' will be over-written later below. - - sm_aw(i,kb) = smcl(i,ncv)/alph1 - ! Calculate wcap at all interfaces of CL. Put a minimum threshold on TKE ! to prevent possible division by zero. 'wcap' at CL internal interfaces ! are already calculated in the first part of 'do ncv' loop correctly. @@ -2122,8 +2111,6 @@ subroutine caleddy( pcols , pver , ncol , bprod(i,k) = -kvh(i,k) * n2(i,k) sprod(i,k) = kvm(i,k) * s2(i,k) - sm_aw(i,k) = sm/alph1 ! This is diagnostic output for use in the microphysics - end if end do ! k @@ -2192,7 +2179,6 @@ subroutine caleddy( pcols , pver , ncol , wcap(i,k) = tke_imsi / b1 bprod(i,k) = -kvh_imsi * n2(i,k) sprod(i,k) = kvm_imsi * s2(i,k) - sm_aw(i,k) = sm/alph1 ! This is diagnostic output for use in the microphysics turbtype(i,k) = 1 ! This was added on Dec.10.2009 for use in microphysics. endif @@ -2257,7 +2243,6 @@ subroutine caleddy( pcols , pver , ncol , else sm_a(i,pver+1) = max(0._r8,(alph1+alph2*gh)/(1._r8+alph3*gh)/(1._r8+alph4exs*gh)) endif - sm_aw(i,pver+1) = sm_a(i,pver+1)/alph1 ri_a(i,pver+1) = -(sm_a(i,pver+1)/sh_a(i,pver+1))*(bprod(i,pver+1)/sprod(i,pver+1)) do k = 1, pver diff --git a/src/physics/cam/eddy_diff_cam.F90 b/src/physics/cam/eddy_diff_cam.F90 index f8660e35f1..1742bf5038 100644 --- a/src/physics/cam/eddy_diff_cam.F90 +++ b/src/physics/cam/eddy_diff_cam.F90 @@ -321,7 +321,7 @@ subroutine eddy_diff_tend(state, pbuf, cam_in, & ztodt, p, tint, rhoi, cldn, wstarent, & kvm_in, kvh_in, ksrftms, dragblj,tauresx, tauresy, & rrho, ustar, pblh, kvm, kvh, kvq, cgh, cgs, tpert, qpert, & - tke, sprod, sfi, turbtype, sm_aw) + tke, sprod, sfi) use physics_types, only: physics_state use camsrfexch, only: cam_in_t @@ -355,8 +355,6 @@ subroutine eddy_diff_tend(state, pbuf, cam_in, & real(r8), intent(out) :: tke(pcols,pver+1) real(r8), intent(out) :: sprod(pcols,pver+1) real(r8), intent(out) :: sfi(pcols,pver+1) - integer(i4), intent(out) :: turbtype(pcols,pver+1) - real(r8), intent(out) :: sm_aw(pcols,pver+1) integer :: i, k @@ -370,7 +368,7 @@ subroutine eddy_diff_tend(state, pbuf, cam_in, & kvh , kvq , cgh , & cgs , tpert , qpert , tke , & sprod , sfi , & - tauresx , tauresy , ksrftms , dragblj , turbtype , sm_aw ) + tauresx , tauresy , ksrftms , dragblj ) ! The diffusivities from diag_TKE can be much larger than from HB in the free ! troposphere and upper atmosphere. These seem to be larger than observations, @@ -416,7 +414,7 @@ subroutine compute_eddy_diff( pbuf, lchnk , ustar , pblh , kvm_in , kvh_in , kvm_out , kvh_out , kvq , & cgh , cgs , tpert , qpert , tke , & sprod , sfi , & - tauresx, tauresy, ksrftms, dragblj, turbtype, sm_aw ) + tauresx, tauresy, ksrftms, dragblj ) !-------------------------------------------------------------------- ! ! Purpose: Interface to compute eddy diffusivities. ! @@ -490,10 +488,6 @@ subroutine compute_eddy_diff( pbuf, lchnk , real(r8), intent(out) :: tke(pcols,pver+1) ! Turbulent kinetic energy [ m2/s2 ] real(r8), intent(out) :: sprod(pcols,pver+1) ! Shear production [ m2/s3 ] real(r8), intent(out) :: sfi(pcols,pver+1) ! Interfacial layer saturation fraction [ fraction ] - integer(i4), intent(out):: turbtype(pcols,pver+1) ! Turbulence type identifier at all interfaces [ no unit ] - real(r8), intent(out) :: sm_aw(pcols,pver+1) ! Normalized Galperin instability function for momentum [ no unit ] - ! This is 1 when neutral condition (Ri=0), - ! 4.964 for maximum unstable case, and 0 when Ri > Ricrit=0.19. ! ---------------------- ! ! Input-Output Variables ! @@ -623,6 +617,8 @@ subroutine compute_eddy_diff( pbuf, lchnk , ! For sedimentation-entrainment feedback real(r8) :: wsed(pcols,ncvmax) ! Sedimentation velocity at the top of each CL [ m/s ] + integer(i4) :: turbtype(pcols,pver+1) ! Turbulence type identifier at all interfaces [ no unit ] + ! ---------- ! ! Parameters ! ! ---------- ! @@ -738,7 +734,7 @@ subroutine compute_eddy_diff( pbuf, lchnk , kvh , kvm , kvh_out , kvm_out , & tpert , qpert , qrl , kvf , tke , & wstarent , bprod , sprod , minpblh , wpert , & - tkes , went , turbtype , sm_aw , & + tkes , went , turbtype , & kbase_o , ktop_o , ncvfin_o , & kbase_mg , ktop_mg , ncvfin_mg , & kbase_f , ktop_f , ncvfin_f , & diff --git a/src/physics/cam/gw_common.F90 b/src/physics/cam/gw_common.F90 index ae91ec08ce..04014c8c97 100644 --- a/src/physics/cam/gw_common.F90 +++ b/src/physics/cam/gw_common.F90 @@ -98,7 +98,7 @@ module gw_common real(r8) :: dc ! Reference speeds [m/s]. real(r8), allocatable :: cref(:) - ! Critical Froude number, squared (usually 1, but CAM3 used 0.5). + ! Critical Froude number, squared real(r8) :: fcrit2 ! Horizontal wave number [1/m]. real(r8) :: kwv diff --git a/src/physics/cam/gw_drag.F90 b/src/physics/cam/gw_drag.F90 index 0f48e661af..798ad63059 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() @@ -217,14 +235,9 @@ subroutine gw_drag_readnl(nlfile) integer :: pgwv_long = -1 real(r8) :: gw_dc_long = unset_r8 - ! fcrit2 for the mid-scale waves has been made a namelist variable to - ! facilitate backwards compatibility with the CAM3 version of this - ! parameterization. In CAM3, fcrit2=0.5. - real(r8) :: fcrit2 = unset_r8 ! critical froude number squared - 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, & + 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 +245,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 @@ -302,8 +315,6 @@ subroutine gw_drag_readnl(nlfile) call mpi_bcast(gw_oro_south_fac, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: gw_oro_south_fac") - call mpi_bcast(fcrit2, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fcrit2") call mpi_bcast(frontgfc, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: frontgfc") call mpi_bcast(taubgnd, 1, mpi_real8, mstrid, mpicom, ierr) @@ -332,14 +343,14 @@ 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") - ! Check if fcrit2 was set. - call shr_assert(fcrit2 /= unset_r8, & - "gw_drag_readnl: fcrit2 must be set via the namelist."// & - errMsg(__FILE__, __LINE__)) + 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 pgwv was set. call shr_assert(pgwv >= 0, & @@ -352,9 +363,10 @@ subroutine gw_drag_readnl(nlfile) "gw_drag_readnl: gw_dc must be set via the namelist."// & errMsg(__FILE__, __LINE__)) - band_oro = GWBand(0, gw_dc, fcrit2, wavelength_mid) + band_oro = GWBand(0, gw_dc, 1.0_r8, 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 +480,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 +518,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 +561,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 +571,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 +710,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 +722,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 +810,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 +853,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 +886,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 +908,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 +927,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 +1031,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 +1041,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 +1078,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 +1088,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 +1110,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 +1182,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 +1210,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 +1272,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 +1465,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 +1482,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 +1517,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 +1542,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 +1622,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 +1687,125 @@ 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 + if (ttend_dp_idx > 0) then + call pbuf_get_field(pbuf, ttend_dp_idx, ttend_dp) + else + allocate(ttend_dp(pcols,pver), stat=istat) + call alloc_err(istat, 'gw_tend', 'ttend_dp', pcols*pver) + ttend_dp = 0.0_r8 + end if + + ! 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 variables that are no longer used: + deallocate(tau, gwut, phase_speeds) + + !Deallocate/nullify ttend_dp if not a pbuf variable: + if (ttend_dp_idx <= 0) then + deallocate(ttend_dp) + nullify(ttend_dp) + end if + + 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 +1821,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 +1869,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 +1878,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 +1888,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 +1909,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 +1953,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 +1962,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 +1982,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 +1997,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 +2045,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 +2059,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 +2085,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 +2136,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 +2150,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 +2173,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 +2192,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 +2241,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 +2396,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 +2495,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 +2519,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 +2539,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 +2635,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 +2669,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 +2713,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 +2725,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 +2747,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 +2760,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 +2812,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 +2846,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..3aa7e8d952 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') @@ -1380,6 +1391,7 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) use tropopause, only: tropopause_find, TROP_ALG_CPP, TROP_ALG_NONE, NOTFOUND use wv_saturation, only: qsat use infnan, only: nan, assignment(=) + use perf_mod, only: t_startf, t_stopf type(physics_state), intent(in) :: state type(physics_ptend), intent(out) :: ptend @@ -1603,7 +1615,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 +1849,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 @@ -1845,6 +1888,7 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) nan_array = nan + call t_startf('micro_pumas_cam_tend:NAR') call phys_getopts(use_subcol_microp_out=use_subcol_microp) ! Set the col_type flag to grid or subcolumn dependent on the value of use_subcol_microp @@ -1871,6 +1915,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 +2110,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 +2221,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 @@ -2265,6 +2356,7 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) frzimm(:ncol,:top_lev-1)=0._r8 frzcnt(:ncol,:top_lev-1)=0._r8 frzdep(:ncol,:top_lev-1)=0._r8 + call t_stopf('micro_pumas_cam_tend:NAR') do it = 1, num_steps @@ -2313,6 +2405,7 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) end select case(2:3) + call t_startf('micro_pumas_cam_tend:micro_pumas_tend') call micro_pumas_tend( & ncol, nlev, dtime/num_steps,& state_loc%t(:ncol,top_lev:), state_loc%q(:ncol,top_lev:,ixq), & @@ -2381,8 +2474,10 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) tnd_qsnow(:ncol,top_lev:),tnd_nsnow(:ncol,top_lev:),re_ice(:ncol,top_lev:),& prer_evap(:ncol,top_lev:), & frzimm(:ncol,top_lev:), frzcnt(:ncol,top_lev:), frzdep(:ncol,top_lev:) ) + call t_stopf('micro_pumas_cam_tend:micro_pumas_tend') end select + call t_startf('micro_pumas_cam_tend:NAR') call handle_errmsg(errstring, subname="micro_pumas_tend") call physics_ptend_init(ptend_loc, psetcols, "micro_pumas", & @@ -2856,17 +2951,25 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) rel_fn_grid = 10._r8 ncic_grid = 1.e8_r8 + call t_stopf('micro_pumas_cam_tend:NAR') do k = top_lev, pver + call t_startf('micro_pumas_cam_tend:DTO'); !$acc data copyin (mg_liq_props,icwmrst_grid(:ngrdcol,k),rho_grid(:ngrdcol,k)) & !$acc copy (ncic_grid(:ngrdcol,k)) & !$acc copyout (mu_grid(:ngrdcol,k),lambdac_grid(:ngrdcol,k)) + call t_stopf('micro_pumas_cam_tend:DTO'); + call t_startf('micro_pumas_cam_tend:ACCR'); call size_dist_param_liq(mg_liq_props, icwmrst_grid(:ngrdcol,k), & ncic_grid(:ngrdcol,k), rho_grid(:ngrdcol,k), & mu_grid(:ngrdcol,k), lambdac_grid(:ngrdcol,k), ngrdcol) + call t_stopf('micro_pumas_cam_tend:ACCR'); + call t_startf('micro_pumas_cam_tend:DTO'); !$acc end data + call t_stopf('micro_pumas_cam_tend:DTO'); end do + call t_startf('micro_pumas_cam_tend:NAR') where (icwmrst_grid(:ngrdcol,top_lev:) > qsmall) rel_fn_grid(:ngrdcol,top_lev:) = & (mu_grid(:ngrdcol,top_lev:) + 3._r8)/ & @@ -2882,17 +2985,25 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) ! Calculate ncic on the grid ncic_grid(:ngrdcol,top_lev:) = nc_grid(:ngrdcol,top_lev:) / & max(mincld,liqcldf_grid(:ngrdcol,top_lev:)) + call t_stopf('micro_pumas_cam_tend:NAR') do k = top_lev, pver + call t_startf('micro_pumas_cam_tend:DTO'); !$acc data copyin (mg_liq_props,icwmrst_grid(:ngrdcol,k), rho_grid(:ngrdcol,k)) & !$acc copy (ncic_grid(:ngrdcol,k)) & !$acc copyout (mu_grid(:ngrdcol,k),lambdac_grid(:ngrdcol,k)) + call t_stopf('micro_pumas_cam_tend:DTO'); + call t_startf('micro_pumas_cam_tend:ACCR'); call size_dist_param_liq(mg_liq_props, icwmrst_grid(:ngrdcol,k), & ncic_grid(:ngrdcol,k), rho_grid(:ngrdcol,k), & mu_grid(:ngrdcol,k), lambdac_grid(:ngrdcol,k), ngrdcol) + call t_stopf('micro_pumas_cam_tend:ACCR'); + call t_startf('micro_pumas_cam_tend:DTO'); !$acc end data + call t_stopf('micro_pumas_cam_tend:DTO'); end do + call t_startf('micro_pumas_cam_tend:NAR') where (icwmrst_grid(:ngrdcol,top_lev:) >= qsmall) rel_grid(:ngrdcol,top_lev:) = & (mu_grid(:ngrdcol,top_lev:) + 3._r8) / & @@ -2986,16 +3097,24 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) niic_grid(:ngrdcol,top_lev:) = ni_grid(:ngrdcol,top_lev:) / & max(mincld,icecldf_grid(:ngrdcol,top_lev:)) + call t_stopf('micro_pumas_cam_tend:NAR') do k = top_lev, pver + call t_startf('micro_pumas_cam_tend:DTO'); !$acc data copyin (mg_ice_props, icimrst_grid(:ngrdcol,k)) & !$acc copy (niic_grid(:ngrdcol,k)) & !$acc copyout (rei_grid(:ngrdcol,k)) + call t_stopf('micro_pumas_cam_tend:DTO'); + call t_startf('micro_pumas_cam_tend:ACCR'); call size_dist_param_basic(mg_ice_props,icimrst_grid(:ngrdcol,k), & niic_grid(:ngrdcol,k),rei_grid(:ngrdcol,k),ngrdcol) + call t_stopf('micro_pumas_cam_tend:ACCR'); + call t_startf('micro_pumas_cam_tend:DTO'); !$acc end data + call t_stopf('micro_pumas_cam_tend:DTO'); end do + call t_startf('micro_pumas_cam_tend:NAR') where (icimrst_grid(:ngrdcol,top_lev:) >= qsmall) rei_grid(:ngrdcol,top_lev:) = 1.5_r8/rei_grid(:ngrdcol,top_lev:) & * 1.e6_r8 @@ -3123,6 +3242,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 ! ! --------------------- ! @@ -3467,6 +3643,7 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) if (qsatfac_idx <= 0) then deallocate(qsatfac) end if + call t_stopf('micro_pumas_cam_tend:NAR') end subroutine micro_pumas_cam_tend 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/phys_grid.F90 b/src/physics/cam/phys_grid.F90 index ca1670e4c2..e87726469f 100644 --- a/src/physics/cam/phys_grid.F90 +++ b/src/physics/cam/phys_grid.F90 @@ -111,6 +111,7 @@ module phys_grid ! The identifier for the physics grid integer, parameter, public :: phys_decomp = 100 + integer, parameter, public :: phys_decomp_scm = 200 ! dynamics field grid information integer, private :: hdim1_d, hdim2_d @@ -451,6 +452,8 @@ subroutine phys_grid_init( ) !----------------------------------------------------------------------- use mpi, only: MPI_REAL8, MPI_MAX use shr_mem_mod, only: shr_mem_getusage + use shr_scam_mod, only: shr_scam_GetCloseLatLon + use scamMod, only: closeioplonidx, closeioplatidx, single_column use pmgrid, only: plev use dycore, only: dycore_is use dyn_grid, only: get_block_bounds_d, & @@ -525,6 +528,7 @@ subroutine phys_grid_init( ) real(r8), allocatable :: latdeg_p(:) real(r8), allocatable :: londeg_p(:) integer(iMap), pointer :: grid_map(:,:) + integer(iMap), pointer :: grid_map_scm(:,:) integer(iMap), allocatable :: coord_map(:) type(horiz_coord_t), pointer :: lat_coord type(horiz_coord_t), pointer :: lon_coord @@ -540,6 +544,7 @@ subroutine phys_grid_init( ) nullify(lonvals) nullify(latvals) nullify(grid_map) + if (single_column) nullify(grid_map_scm) nullify(lat_coord) nullify(lon_coord) @@ -1105,10 +1110,13 @@ subroutine phys_grid_init( ) unstructured = dycore_is('UNSTRUCTURED') if (unstructured) then allocate(grid_map(3, pcols * (endchunk - begchunk + 1))) + if (single_column) allocate(grid_map_scm(3, pcols * (endchunk - begchunk + 1))) else allocate(grid_map(4, pcols * (endchunk - begchunk + 1))) + if (single_column) allocate(grid_map_scm(4, pcols * (endchunk - begchunk + 1))) end if grid_map = 0 + if (single_column) grid_map_scm = 0 allocate(latvals(size(grid_map, 2))) allocate(lonvals(size(grid_map, 2))) p = 0 @@ -1132,12 +1140,21 @@ subroutine phys_grid_init( ) p = p + 1 grid_map(1, p) = i grid_map(2, p) = lcid + if (single_column) then + grid_map_scm(1, p) = i + grid_map_scm(2, p) = lcid + end if if ((i <= ncols) .and. (gcols(i) > 0)) then if (unstructured) then grid_map(3, p) = gcols(i) + if (single_column) grid_map_scm(3, p) = closeioplonidx else - grid_map(3, p) = get_lon_p(lcid, i) - grid_map(4, p) = get_lat_p(lcid, i) + grid_map(3, p) = get_lon_p(lcid, i) + grid_map(4, p) = get_lat_p(lcid, i) + if (single_column) then + grid_map_scm(3, p) = closeioplonidx + grid_map_scm(4, p) = closeioplatidx + end if end if else if (i <= ncols) then @@ -1184,6 +1201,8 @@ subroutine phys_grid_init( ) end if call cam_grid_register('physgrid', phys_decomp, lat_coord, lon_coord, & grid_map, unstruct=unstructured, block_indexed=.true.) + if (single_column) call cam_grid_register('physgrid_scm', phys_decomp_scm, lat_coord, lon_coord, & + grid_map_scm, unstruct=unstructured, block_indexed=.true.) ! Copy required attributes from the dynamics array nullify(copy_attributes) call physgrid_copy_attributes_d(copy_gridname, copy_attributes) @@ -1223,6 +1242,7 @@ subroutine phys_grid_init( ) end if ! Cleanup pointers (they belong to the grid now) nullify(grid_map) + if (single_column) nullify(grid_map_scm) deallocate(latvals) nullify(latvals) deallocate(lonvals) 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..44c2e86c5a 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 @@ -129,8 +130,6 @@ subroutine phys_register use tracers, only: tracers_register use check_energy, only: check_energy_register use carma_intr, only: carma_register - use cam3_aero_data, only: cam3_aero_data_on, cam3_aero_data_register - use cam3_ozone_data, only: cam3_ozone_data_on, cam3_ozone_data_register use ghg_data, only: ghg_data_register use vertical_diffusion, only: vd_register use convect_deep, only: convect_deep_register @@ -280,9 +279,6 @@ subroutine phys_register call co2_register() ! register data model ozone with pbuf - if (cam3_ozone_data_on) then - call cam3_ozone_data_register() - end if call prescribed_volcaero_register() call prescribed_strataero_register() call prescribed_ozone_register() @@ -290,11 +286,6 @@ subroutine phys_register call prescribed_ghg_register() call sslt_rebin_register - ! CAM3 prescribed aerosols - if (cam3_aero_data_on) then - call cam3_aero_data_register() - end if - ! register various data model gasses with pbuf call ghg_data_register() @@ -742,8 +733,6 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use convect_shallow, only: convect_shallow_init use cam_diagnostics, only: diag_init use gw_drag, only: gw_init - use cam3_aero_data, only: cam3_aero_data_on, cam3_aero_data_init - use cam3_ozone_data, only: cam3_ozone_data_on, cam3_ozone_data_init use radheat, only: radheat_init use radiation, only: radiation_init use cloud_diagnostics, only: cloud_diagnostics_init @@ -777,7 +766,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use sslt_rebin, only: sslt_rebin_init use tropopause, only: tropopause_init use solar_data, only: solar_data_init - use dadadj_cam, only: dadadj_init + use dadadj_cam, only: dadadj_cam_init use cam_abortutils, only: endrun use nudging, only: Nudge_Model, nudging_init use cam_snapshot, only: cam_snapshot_init @@ -858,9 +847,6 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! solar irradiance data modules call solar_data_init() - ! CAM3 prescribed aerosols - if (cam3_aero_data_on) call cam3_aero_data_init(phys_state) - ! Initialize rad constituents and their properties call rad_cnst_init() @@ -891,9 +877,6 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) call co2_init() end if - ! CAM3 prescribed ozone - if (cam3_ozone_data_on) call cam3_ozone_data_init(phys_state) - call gw_init() call rayleigh_friction_init() @@ -909,7 +892,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) @@ -952,7 +935,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) #endif call sslt_rebin_init() call tropopause_init() - call dadadj_init() + call dadadj_cam_init() prec_dp_idx = pbuf_get_index('PREC_DP') snow_dp_idx = pbuf_get_index('SNOW_DP') @@ -1087,9 +1070,7 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) use spcam_drivers, only: tphysbc_spcam use spmd_utils, only: mpicom use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_allocate -#if (defined BFB_CAM_SCAM_IOP ) - use cam_history, only: outfld -#endif + use cam_history, only: outfld, write_camiop use cam_abortutils, only: endrun #if ( defined OFFLINE_DYN ) use metdata, only: get_met_srf1 @@ -1157,11 +1138,11 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) !----------------------------------------------------------------------- ! -#if (defined BFB_CAM_SCAM_IOP ) - do c=begchunk, endchunk - call outfld('Tg',cam_in(c)%ts,pcols ,c ) - end do -#endif + if (write_camiop) then + do c=begchunk, endchunk + call outfld('Tg',cam_in(c)%ts,pcols ,c ) + end do + end if call t_barrierf('sync_bc_physics', mpicom) call t_startf ('bc_physics') @@ -1576,7 +1557,9 @@ subroutine tphysac (ztodt, cam_in, & call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat) end if - call aoa_tracers_timestep_tend(state, ptend, cam_in%cflx, cam_in%landfrac, ztodt) + call t_startf('tphysac:aoa_tracers_timestep_tend') + call aoa_tracers_timestep_tend(state, ptend, ztodt) + call t_stopf('tphysac:aoa_tracers_timestep_tend') if ( (trim(cam_take_snapshot_after) == "aoa_tracers_timestep_tend") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) @@ -1593,7 +1576,9 @@ subroutine tphysac (ztodt, cam_in, & call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat) end if + call t_startf('tphysac:co2_cycle_set_ptend') call co2_cycle_set_ptend(state, pbuf, ptend) + call t_stopf('tphysac:co2_cycle_set_ptend') if ( (trim(cam_take_snapshot_after) == "co2_cycle_set_ptend") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) @@ -1620,8 +1605,10 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if + call t_startf('tphysac:chem_timestep_tend') call chem_timestep_tend(state, ptend, cam_in, cam_out, ztodt, & pbuf, fh2o=fh2o) + call t_stopf('tphysac:chem_timestep_tend') if ( (trim(cam_take_snapshot_after) == "chem_timestep_tend") .and. & @@ -1645,7 +1632,7 @@ subroutine tphysac (ztodt, cam_in, & ! Call vertical diffusion code (pbl, free atmosphere and molecular) !=================================================== - call t_startf('vertical_diffusion_tend') + call t_startf('tphysac:vertical_diffusion_tend') if (trim(cam_take_snapshot_before) == "vertical_diffusion_section") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& @@ -1679,12 +1666,12 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if - call t_stopf ('vertical_diffusion_tend') + call t_stopf ('tphysac:vertical_diffusion_tend') !=================================================== ! Rayleigh friction calculation !=================================================== - call t_startf('rayleigh_friction') + call t_startf('tphysac:rayleigh_friction_tend') call rayleigh_friction_tend( ztodt, state, ptend) if ( ptend%lu ) then call outfld( 'UTEND_RAYLEIGH', ptend%u, pcols, lchnk) @@ -1693,7 +1680,7 @@ subroutine tphysac (ztodt, cam_in, & call outfld( 'VTEND_RAYLEIGH', ptend%v, pcols, lchnk) end if call physics_update(state, ptend, ztodt, tend) - call t_stopf('rayleigh_friction') + call t_stopf('tphysac:rayleigh_friction_tend') if (do_clubb_sgs) then call check_energy_chng(state, tend, "vdiff", nstep, ztodt, zero, zero, zero, zero) @@ -1705,7 +1692,7 @@ subroutine tphysac (ztodt, cam_in, & call check_tracers_chng(state, tracerint, "vdiff", nstep, ztodt, cam_in%cflx) ! aerosol dry deposition processes - call t_startf('aero_drydep') + call t_startf('tphysac:aero_model_drydep') if (trim(cam_take_snapshot_before) == "aero_model_drydep") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& @@ -1724,7 +1711,7 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if - call t_stopf('aero_drydep') + call t_stopf('tphysac:aero_model_drydep') ! CARMA microphysics ! @@ -1734,12 +1721,12 @@ subroutine tphysac (ztodt, cam_in, & ! that cam_out%xxxdryxxx fields have already been set for CAM aerosols and cam_out ! can be added to for CARMA aerosols. if (carma_do_aerosol) then - call t_startf('carma_timestep_tend') + call t_startf('tphysac:carma_timestep_tend') call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, obklen=obklen, ustar=surfric) call physics_update(state, ptend, ztodt, tend) call check_energy_chng(state, tend, "carma_tend", nstep, ztodt, zero, zero, zero, zero) - call t_stopf('carma_timestep_tend') + call t_stopf('tphysac:carma_timestep_tend') end if @@ -1751,7 +1738,7 @@ subroutine tphysac (ztodt, cam_in, & !=================================================== ! Gravity wave drag !=================================================== - call t_startf('gw_tend') + call t_startf('tphysac:gw_tend') if (trim(cam_take_snapshot_before) == "gw_tend") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& @@ -1780,7 +1767,7 @@ subroutine tphysac (ztodt, cam_in, & ! Check energy integrals call check_energy_chng(state, tend, "gwdrag", nstep, ztodt, zero, & zero, zero, flx_heat) - call t_stopf('gw_tend') + call t_stopf('tphysac:gw_tend') ! QBO relaxation @@ -1948,7 +1935,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 +2054,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 +2113,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 @@ -2136,8 +2122,8 @@ subroutine tphysbc (ztodt, state, & integer :: ixcldice, ixcldliq, ixq ! constituent indices for cloud liquid and ice water. integer :: m, m_cnst ! for macro/micro co-substepping - integer :: macmic_it ! iteration variables - real(r8) :: cld_macmic_ztodt ! modified timestep + integer :: macmic_it ! iteration variables + real(r8) :: cld_macmic_ztodt ! modified timestep ! physics buffer fields to compute tendencies for stratiform package integer itim_old, ifld real(r8), pointer, dimension(:,:) :: cld ! cloud fraction @@ -2323,14 +2309,15 @@ subroutine tphysbc (ztodt, state, & !=================================================== ! Dry adjustment !=================================================== - call t_startf('dry_adjustment') 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 t_startf('tphysbc:dadadj_tend') call dadadj_tend(ztodt, state, ptend) + call t_stopf('tphysbc:dadadj_tend') if ( (trim(cam_take_snapshot_after) == "dadadj_tend") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then @@ -2340,29 +2327,29 @@ 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') !=================================================== ! Moist convection !=================================================== call t_startf('moist_convection') - call t_startf ('convect_deep_tend') 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 t_startf ('tphysbc:convect_deep_tend') call convect_deep_tend( & cmfmc, cmfcme, & - pflx, zdu, & + zdu, & rliq, rice, & ztodt, & state, ptend, cam_in%landfrac, pbuf) + call t_stopf('tphysbc:convect_deep_tend') if ( (trim(cam_take_snapshot_after) == "convect_deep_tend") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then @@ -2379,10 +2366,9 @@ 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') call pbuf_get_field(pbuf, prec_dp_idx, prec_dp ) call pbuf_get_field(pbuf, snow_dp_idx, snow_dp ) @@ -2409,7 +2395,6 @@ subroutine tphysbc (ztodt, state, & ! ! Call Hack (1994) convection scheme to deal with shallow/mid-level convection ! - call t_startf ('convect_shallow_tend') if (dlfzm_idx > 0) then call pbuf_get_field(pbuf, dlfzm_idx, dlfzm) @@ -2420,13 +2405,14 @@ 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 t_startf ('tphysbc:convect_shallow_tend') call convect_shallow_tend (ztodt , cmfmc, & dlf , dlf2 , rliq , rliq2, & state , ptend , pbuf, cam_in) - call t_stopf ('convect_shallow_tend') + call t_stopf ('tphysbc:convect_shallow_tend') if ( (trim(cam_take_snapshot_after) == "convect_shallow_tend") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then @@ -2442,7 +2428,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) @@ -2468,9 +2454,9 @@ subroutine tphysbc (ztodt, state, & ! snow are stored in the physics buffer and will be incorporated by the MG microphysics. ! ! Currently CARMA cloud microphysics is only supported with the MG microphysics. - call t_startf('carma_timestep_tend') if (carma_do_cldice .or. carma_do_cldliq) then + call t_startf('tphysbc:carma_timestep_tend') call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, dlf=dlf, rliq=rliq, & prec_str=prec_str, snow_str=snow_str, prec_sed=prec_sed_carma, snow_sed=snow_sed_carma) call physics_update(state, ptend, ztodt, tend) @@ -2482,16 +2468,16 @@ subroutine tphysbc (ztodt, state, & else call check_energy_chng(state, tend, "carma_tend", nstep, ztodt, zero, prec_str, snow_str, zero) end if + call t_stopf('tphysbc:carma_timestep_tend') end if - call t_stopf('carma_timestep_tend') if( microp_scheme == 'RK' ) then !=================================================== ! Calculate stratiform tendency (sedimentation, detrain, cloud fraction and microphysics ) !=================================================== - call t_startf('rk_stratiform_tend') + call t_startf('tphysbc:rk_stratiform_tend') call rk_stratiform_tend(state, ptend, pbuf, ztodt, & cam_in%icefrac, cam_in%landfrac, cam_in%ocnfrac, & @@ -2504,7 +2490,7 @@ subroutine tphysbc (ztodt, state, & call physics_update(state, ptend, ztodt, tend) call check_energy_chng(state, tend, "cldwat_tend", nstep, ztodt, zero, prec_str, snow_str, zero) - call t_stopf('rk_stratiform_tend') + call t_stopf('tphysbc:rk_stratiform_tend') elseif( microp_scheme == 'MG' ) then ! Start co-substepping of macrophysics and microphysics @@ -2533,16 +2519,16 @@ subroutine tphysbc (ztodt, state, & ! Calculate macrophysical tendency (sedimentation, detrain, cloud fraction) !=================================================== - call t_startf('macrop_tend') ! don't call Park macrophysics if CLUBB is called if (macrop_scheme .ne. 'CLUBB_SGS') then 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 t_startf('tphysbc:macrop_driver_tend') call macrop_driver_tend( & state, ptend, cld_macmic_ztodt, & cam_in%landfrac, cam_in%ocnfrac, cam_in%snowhland, & ! sediment @@ -2550,6 +2536,7 @@ subroutine tphysbc (ztodt, state, & cmfmc, & cam_in%ts, cam_in%sst, zdu, & pbuf, det_s, det_ice) + call t_stopf('tphysbc:macrop_driver_tend') ! Since we "added" the reserved liquid back in this routine, we need ! to account for it in the energy checker @@ -2571,7 +2558,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,12 +2574,14 @@ 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 t_startf('tphysbc:clubb_tend_cam') call clubb_tend_cam(state, ptend, pbuf, cld_macmic_ztodt,& cmfmc, cam_in, macmic_it, cld_macmic_num_steps, & dlf, det_s, det_ice) + call t_stopf('tphysbc:clubb_tend_cam') ! Since we "added" the reserved liquid back in this routine, we need ! to account for it in the energy checker @@ -2617,7 +2606,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 @@ -2629,7 +2618,6 @@ subroutine tphysbc (ztodt, state, & endif - call t_stopf('macrop_tend') !=================================================== ! Calculate cloud microphysics @@ -2654,20 +2642,19 @@ 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') + call t_startf('tphysbc:microp_aero_run') call microp_aero_run(state, ptend_aero, cld_macmic_ztodt, pbuf) - call t_stopf('microp_aero_run') + call t_stopf('tphysbc:microp_aero_run') - call t_startf('microp_tend') if (use_subcol_microp) then 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 +2706,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", & @@ -2731,7 +2718,9 @@ subroutine tphysbc (ztodt, state, & call physics_tend_dealloc(tend_sc) call physics_ptend_dealloc(ptend_sc) else + call t_startf('tphysbc:microp_driver_tend') call microp_driver_tend(state, ptend, cld_macmic_ztodt, pbuf) + call t_stopf('tphysbc:microp_driver_tend') end if ! combine aero and micro tendencies for the grid call physics_ptend_sum(ptend_aero, ptend, ncol) @@ -2751,14 +2740,13 @@ 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, & zero, prec_str(:ncol)/cld_macmic_num_steps, & snow_str(:ncol)/cld_macmic_num_steps, zero) - call t_stopf('microp_tend') prec_sed_macmic(:ncol) = prec_sed_macmic(:ncol) + prec_sed(:ncol) snow_sed_macmic(:ncol) = snow_sed_macmic(:ncol) + snow_sed(:ncol) prec_pcw_macmic(:ncol) = prec_pcw_macmic(:ncol) + prec_pcw(:ncol) @@ -2798,18 +2786,40 @@ 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 t_startf('tphysbc:modal_aero_calcsize_sub') + call modal_aero_calcsize_sub(state, ptend, ztodt, pbuf) + call t_stopf('tphysbc:modal_aero_calcsize_sub') + ! for prognostic modal aerosols the transfer of mass between aitken and accumulation + ! modes is done in conjunction with the dry radius calculation + call t_startf('tphysbc:modal_aero_wateruptake_dr') + call modal_aero_wateruptake_dr(state, pbuf) + call t_stopf('tphysbc:modal_aero_wateruptake_dr') + call physics_update(state, ptend, ztodt, tend) + else + call t_startf('tphysbc:modal_aero_calcsize_diag') + call modal_aero_calcsize_diag(state, pbuf) + call t_stopf('tphysbc:modal_aero_calcsize_diag') + call t_startf('tphysbc:modal_aero_wateruptake_dr') + call modal_aero_wateruptake_dr(state, pbuf) + call t_stopf('tphysbc:modal_aero_wateruptake_dr') + 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 t_startf('tphysbc:aero_model_wetdep') call aero_model_wetdep( state, ztodt, dlf, cam_out, ptend, pbuf) + call t_stopf('tphysbc:aero_model_wetdep') if ( (trim(cam_take_snapshot_after) == "aero_model_wetdep") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) @@ -2818,7 +2828,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 @@ -2827,21 +2837,21 @@ subroutine tphysbc (ztodt, state, & ! NOTE: It needs to follow aero_model_wetdep, so that cam_out%xxxwetxxx ! fields have already been set for CAM aerosols and cam_out can be added ! to for CARMA aerosols. - call t_startf ('carma_wetdep_tend') + call t_startf ('tphysbc:carma_wetdep_tend') call carma_wetdep_tend(state, ptend, ztodt, pbuf, dlf, cam_out) call physics_update(state, ptend, ztodt, tend) - call t_stopf ('carma_wetdep_tend') + call t_stopf ('tphysbc:carma_wetdep_tend') end if - call t_startf ('convect_deep_tend2') + call t_startf ('tphysbc:convect_deep_tend2') call convect_deep_tend_2( state, ptend, ztodt, pbuf ) call physics_update(state, ptend, ztodt, tend) - call t_stopf ('convect_deep_tend2') + call t_stopf ('tphysbc:convect_deep_tend2') ! 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 @@ -2869,15 +2879,16 @@ subroutine tphysbc (ztodt, state, & !=================================================== ! Radiation computations !=================================================== - call t_startf('radiation') 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 t_startf('tphysbc:radiation_tend') call radiation_tend( & state, ptend, pbuf, cam_out, cam_in, net_flx) + call t_stopf('tphysbc:radiation_tend') ! Set net flux used by spectral dycores do i=1,ncol @@ -2892,12 +2903,11 @@ 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) - call t_stopf('radiation') ! Diagnose the location of the tropopause and its location to the history file(s). call t_startf('tropopause') @@ -2930,8 +2940,6 @@ subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) use physics_buffer, only: physics_buffer_desc use carma_intr, only: carma_timestep_init use ghg_data, only: ghg_data_timestep_init - use cam3_aero_data, only: cam3_aero_data_on, cam3_aero_data_timestep_init - use cam3_ozone_data, only: cam3_ozone_data_on, cam3_ozone_data_timestep_init use aoa_tracers, only: aoa_tracers_timestep_init use vertical_diffusion, only: vertical_diffusion_ts_init use radheat, only: radheat_timestep_init @@ -2995,12 +3003,6 @@ subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) ! prescribed aerosol deposition fluxes call aerodep_flx_adv(phys_state, pbuf2d, cam_out) - ! CAM3 prescribed aerosol masses - if (cam3_aero_data_on) call cam3_aero_data_timestep_init(pbuf2d, phys_state) - - ! CAM3 prescribed ozone data - if (cam3_ozone_data_on) call cam3_ozone_data_timestep_init(pbuf2d, phys_state) - ! Time interpolate data models of gasses in pbuf2d call ghg_data_timestep_init(pbuf2d, phys_state) 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/rk_stratiform.F90 b/src/physics/cam/rk_stratiform.F90 index 84607a20b7..a6bcf39be7 100644 --- a/src/physics/cam/rk_stratiform.F90 +++ b/src/physics/cam/rk_stratiform.F90 @@ -3,7 +3,7 @@ module rk_stratiform !------------------------------------------------------------------------------------------------------- ! ! Provides the CAM interface to the Rasch and Kristjansson (RK) -! prognostic cloud microphysics, and the cam3/4 macrophysics. +! prognostic cloud microphysics, and the cam4 macrophysics. ! !------------------------------------------------------------------------------------------------------- @@ -356,7 +356,7 @@ subroutine rk_stratiform_init() call add_default ('EVAPPREC ', history_budget_histfile_num, ' ') call add_default ('CMELIQ ', history_budget_histfile_num, ' ') - if( cam_physpkg_is('cam3') .or. cam_physpkg_is('cam4') ) then + if( cam_physpkg_is('cam4') ) then call add_default ('ZMDLF ', history_budget_histfile_num, ' ') call add_default ('CME ', history_budget_histfile_num, ' ') @@ -954,20 +954,16 @@ subroutine rk_stratiform_tend( & call physics_ptend_sum( ptend_loc, ptend_all, ncol ) call physics_update( state1, ptend_loc, dtime ) - if (.not. cam_physpkg_is('cam3')) then - - call t_startf("cldfrc") - call cldfrc( lchnk, ncol, pbuf, & - state1%pmid, state1%t, state1%q(:,:,1), state1%omega, state1%phis, & - shfrc, use_shfrc, & - cld, rhcloud, clc, state1%pdel, & - cmfmc, cmfmc_sh, landfrac, snowh, concld, cldst, & - ts, sst, state1%pint(:,pverp), zdu, ocnfrac, rhu00, & - state1%q(:,:,ixcldice), icecldf, liqcldf, & - relhum, 0 ) - call t_stopf("cldfrc") - - endif + call t_startf("cldfrc") + call cldfrc( lchnk, ncol, pbuf, & + state1%pmid, state1%t, state1%q(:,:,1), state1%omega, state1%phis, & + shfrc, use_shfrc, & + cld, rhcloud, clc, state1%pdel, & + cmfmc, cmfmc_sh, landfrac, snowh, concld, cldst, & + ts, sst, state1%pint(:,pverp), zdu, ocnfrac, rhu00, & + state1%q(:,:,ixcldice), icecldf, liqcldf, & + relhum, 0 ) + call t_stopf("cldfrc") call outfld( 'CONCLD ', concld, pcols, lchnk ) call outfld( 'CLDST ', cldst, pcols, lchnk ) 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/uwshcu.F90 b/src/physics/cam/uwshcu.F90 index 914d131a94..a5e5a0c6ea 100644 --- a/src/physics/cam/uwshcu.F90 +++ b/src/physics/cam/uwshcu.F90 @@ -3765,7 +3765,7 @@ subroutine compute_uwshcu( mix , mkx , iend , ncnst , dt ! -------------------------------------------------------------------------- ! ! 'rliq' : Verticall-integrated 'suspended cloud condensate' ! ! [m/s] This is so called 'reserved liquid water' in other subroutines ! - ! of CAM3, since the contribution of this term should not be included into ! + ! of CAM, since the contribution of this term should not be included into ! ! the tendency of each layer or surface flux (precip) within this cumulus ! ! scheme. The adding of this term to the layer tendency will be done inthe ! ! 'stratiform_tend', just after performing sediment process there. ! @@ -3928,9 +3928,9 @@ subroutine compute_uwshcu( mix , mkx , iend , ncnst , dt ! --------------------------------------------------------------------------- ! ! Until now, all the calculations are done completely in this shallow cumulus ! - ! scheme. If you want to use this cumulus scheme other than CAM3, then do not ! + ! scheme. If you want to use this cumulus scheme other than CAM, then do not ! ! perform below block. However, for compatible use with the other subroutines ! - ! in CAM3, I should subtract the effect of 'qc(k)' ('rliq') from the tendency ! + ! in CAM, I should subtract the effect of 'qc(k)' ('rliq') from the tendency ! ! equation in each layer, since this effect will be separately added later in ! ! in 'stratiform_tend' just after performing sediment process there. In order ! ! to be consistent with 'stratiform_tend', just subtract qc(k) from tendency ! diff --git a/src/physics/cam/vertical_diffusion.F90 b/src/physics/cam/vertical_diffusion.F90 index 224d87e3a0..472b2a5501 100644 --- a/src/physics/cam/vertical_diffusion.F90 +++ b/src/physics/cam/vertical_diffusion.F90 @@ -105,7 +105,6 @@ module vertical_diffusion type(vdiff_selector) :: fieldlist_molec ! Logical switches for molecular diffusion integer :: tke_idx, kvh_idx, kvm_idx ! TKE and eddy diffusivity indices for fields in the physics buffer integer :: kvt_idx ! Index for kinematic molecular conductivity -integer :: turbtype_idx, smaw_idx ! Turbulence type and instability functions integer :: tauresx_idx, tauresy_idx ! Redisual stress for implicit surface stress character(len=fieldname_len) :: vdiffnam(pcnst) ! Names of vertical diffusion tendencies @@ -141,6 +140,8 @@ module vertical_diffusion logical :: waccmx_mode = .false. logical :: do_hb_above_clubb = .false. +real(r8),allocatable :: kvm_sponge(:) + contains ! =============================================================================== ! @@ -226,8 +227,6 @@ subroutine vd_register() call pbuf_add_field('kvm', 'global', dtype_r8, (/pcols, pverp/), kvm_idx ) call pbuf_add_field('pblh', 'global', dtype_r8, (/pcols/), pblh_idx) call pbuf_add_field('tke', 'global', dtype_r8, (/pcols, pverp/), tke_idx) - call pbuf_add_field('turbtype', 'global', dtype_i4, (/pcols, pverp/), turbtype_idx) - call pbuf_add_field('smaw', 'global', dtype_r8, (/pcols, pverp/), smaw_idx) call pbuf_add_field('tauresx', 'global', dtype_r8, (/pcols/), tauresx_idx) call pbuf_add_field('tauresy', 'global', dtype_r8, (/pcols/), tauresy_idx) @@ -280,6 +279,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 +289,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 +297,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 +446,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 @@ -624,8 +662,6 @@ subroutine vertical_diffusion_init(pbuf2d) ! Initialization of some pbuf fields if (is_first_step()) then ! Initialization of pbuf fields tke, kvh, kvm are done in phys_inidat - call pbuf_set_field(pbuf2d, turbtype_idx, 0 ) - call pbuf_set_field(pbuf2d, smaw_idx, 0.0_r8) call pbuf_set_field(pbuf2d, tauresx_idx, 0.0_r8) call pbuf_set_field(pbuf2d, tauresy_idx, 0.0_r8) if (trim(shallow_scheme) == 'UNICON') then @@ -633,7 +669,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 +730,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 ! @@ -732,9 +768,6 @@ subroutine vertical_diffusion_tend( & real(r8) :: dtk(pcols,pver) ! T tendency from KE dissipation real(r8), pointer :: tke(:,:) ! Turbulent kinetic energy [ m2/s2 ] - integer(i4),pointer :: turbtype(:,:) ! Turbulent interface types [ no unit ] - real(r8), pointer :: smaw(:,:) ! Normalized Galperin instability function - ! ( 0<= <=4.964 and 1 at neutral ) real(r8), pointer :: qtl_flx(:,:) ! overbar(w'qtl') where qtl = qv + ql real(r8), pointer :: qti_flx(:,:) ! overbar(w'qti') where qti = qv + qi @@ -870,7 +903,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 @@ -881,7 +914,6 @@ subroutine vertical_diffusion_tend( & call pbuf_get_field(pbuf, tpert_idx, tpert) call pbuf_get_field(pbuf, qpert_idx, qpert) call pbuf_get_field(pbuf, pblh_idx, pblh) - call pbuf_get_field(pbuf, turbtype_idx, turbtype) ! Interpolate temperature to interfaces. do k = 2, pver @@ -974,7 +1006,6 @@ subroutine vertical_diffusion_tend( & !----------------------------------------------------------------------- ! call pbuf_get_field(pbuf, kvm_idx, kvm_in) call pbuf_get_field(pbuf, kvh_idx, kvh_in) - call pbuf_get_field(pbuf, smaw_idx, smaw) call pbuf_get_field(pbuf, tke_idx, tke) ! Get potential temperature. @@ -987,7 +1018,7 @@ subroutine vertical_diffusion_tend( & ztodt, p, tint, rhoi, cldn, wstarent, & kvm_in, kvh_in, ksrftms, dragblj, tauresx, tauresy, & rrho, ustar, pblh, kvm, kvh, kvq, cgh, cgs, tpert, qpert, & - tke, sprod, sfi, turbtype, smaw) + tke, sprod, sfi) ! The diag_TKE scheme does not calculate the Monin-Obukhov length, which is used in dry deposition calculations. ! Use the routines from pbl_utils to accomplish this. Assumes ustar and rrho have been set. @@ -1016,7 +1047,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 +1098,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 +1184,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 +1374,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 +1544,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/wv_saturation.F90 b/src/physics/cam/wv_saturation.F90 index ac94482e20..350cd12c9d 100644 --- a/src/physics/cam/wv_saturation.F90 +++ b/src/physics/cam/wv_saturation.F90 @@ -35,6 +35,7 @@ module wv_saturation use wv_sat_methods, only: & svp_to_qsat => wv_sat_svp_to_qsat, & svp_to_qsat_vect => wv_sat_svp_to_qsat_vect +use perf_mod, only: t_startf, t_stopf implicit none private @@ -761,6 +762,7 @@ subroutine qsat_line(t, p, es, qs, gam, dqsdt, enthalpy) real(r8) :: hltalt ! Modified latent heat for T derivatives real(r8) :: tterm ! Account for d(es)/dT in transition region + call t_startf('qsat:CPU') es = estblf(t) qs = svp_to_qsat(es, p) @@ -781,6 +783,7 @@ subroutine qsat_line(t, p, es, qs, gam, dqsdt, enthalpy) gam=gam, dqsdt=dqsdt) end if + call t_stopf('qsat:CPU') end subroutine qsat_line @@ -815,9 +818,12 @@ subroutine qsat_vect(t, p, es, qs, vlen, gam, dqsdt, enthalpy) present_dqsdt = present(dqsdt) present_enthalpy = present(enthalpy) + call t_startf('qsat:DTO') !$acc data copyin (t,p) & !$acc copyout (es,qs,gam,dqsdt,enthalpy) & !$acc create (hltalt,tterm) + call t_stopf('qsat:DTO') + call t_startf('qsat:ACCR') call estblf_vect(t, es, vlen) @@ -846,7 +852,10 @@ subroutine qsat_vect(t, p, es, qs, vlen, gam, dqsdt, enthalpy) end if + call t_stopf('qsat:ACCR') + call t_startf('qsat:DTO') !$acc end data + call t_stopf('qsat:DTO') end subroutine qsat_vect subroutine qsat_2D(t, p, es, qs, dim1, dim2, gam, dqsdt, enthalpy) @@ -881,10 +890,13 @@ subroutine qsat_2D(t, p, es, qs, dim1, dim2, gam, dqsdt, enthalpy) present_dqsdt = present(dqsdt) present_enthalpy = present(enthalpy) + call t_startf('qsat:DTO') !$acc data copyin (t,p) & !$acc copyout (es,qs,gam,dqsdt,enthalpy) & !$acc create (hltalt,tterm) + call t_stopf('qsat:DTO') + call t_startf('qsat:ACCR') call estblf_vect(t, es, vlen) call svp_to_qsat_vect(es, p, qs, vlen) @@ -913,8 +925,11 @@ subroutine qsat_2D(t, p, es, qs, dim1, dim2, gam, dqsdt, enthalpy) gam=gam, dqsdt=dqsdt) end if + call t_stopf('qsat:ACCR') + call t_startf('qsat:DTO') !$acc end data + call t_stopf('qsat:DTO') end subroutine qsat_2D subroutine qsat_water_line(t, p, es, qs, gam, dqsdt, enthalpy) @@ -942,6 +957,7 @@ subroutine qsat_water_line(t, p, es, qs, gam, dqsdt, enthalpy) ! Local variables real(r8) :: hltalt ! Modified latent heat for T derivatives + call t_startf('qsat_water:CPU') call wv_sat_qsat_water(t, p, es, qs) if (present(gam) .or. present(dqsdt) .or. present(enthalpy)) then @@ -957,6 +973,7 @@ subroutine qsat_water_line(t, p, es, qs, gam, dqsdt, enthalpy) gam=gam, dqsdt=dqsdt) end if + call t_stopf('qsat_water:CPU') end subroutine qsat_water_line @@ -993,10 +1010,13 @@ subroutine qsat_water_vect(t, p, es, qs, vlen, gam, dqsdt, enthalpy) present_dqsdt = present(dqsdt) present_enthalpy = present(enthalpy) + call t_startf('qsat_water:DTO') !$acc data copyin (t,p) & !$acc copyout (es,qs,gam,dqsdt,enthalpy) & !$acc create (tterm,hltalt) + call t_stopf('qsat_water:DTO') + call t_startf('qsat_water:ACCR') !$acc parallel vector_length(VLENS) default(present) !$acc loop gang vector do i = 1, vlen @@ -1019,8 +1039,11 @@ subroutine qsat_water_vect(t, p, es, qs, vlen, gam, dqsdt, enthalpy) gam=gam, dqsdt=dqsdt) end if + call t_stopf('qsat_water:ACCR') + call t_startf('qsat_water:DTO') !$acc end data + call t_stopf('qsat_water:DTO') end subroutine qsat_water_vect subroutine qsat_water_2D(t, p, es, qs, dim1, dim2, gam, dqsdt, enthalpy) @@ -1057,10 +1080,13 @@ subroutine qsat_water_2D(t, p, es, qs, dim1, dim2, gam, dqsdt, enthalpy) present_dqsdt = present(dqsdt) present_enthalpy = present(enthalpy) + call t_startf('qsat_water:DTO') !$acc data copyin (t,p) & !$acc copyout (es,qs,gam,dqsdt,enthalpy) & !$acc create (hltalt,tterm) + call t_stopf('qsat_water:DTO') + call t_startf('qsat_water:ACCR') !$acc parallel vector_length(VLENS) default(present) !$acc loop gang vector collapse(2) do k = 1, dim2 @@ -1085,8 +1111,11 @@ subroutine qsat_water_2D(t, p, es, qs, dim1, dim2, gam, dqsdt, enthalpy) gam=gam, dqsdt=dqsdt) end if + call t_stopf('qsat_water:ACCR') + call t_startf('qsat_water:DTO') !$acc end data + call t_stopf('qsat_water:DTO') end subroutine qsat_water_2D subroutine qsat_ice_line(t, p, es, qs, gam, dqsdt, enthalpy) @@ -1114,6 +1143,7 @@ subroutine qsat_ice_line(t, p, es, qs, gam, dqsdt, enthalpy) ! Local variables real(r8) :: hltalt ! Modified latent heat for T derivatives + call t_startf('qsat_ice:CPU') call wv_sat_qsat_ice(t, p, es, qs) if (present(gam) .or. present(dqsdt) .or. present(enthalpy)) then @@ -1128,6 +1158,7 @@ subroutine qsat_ice_line(t, p, es, qs, gam, dqsdt, enthalpy) gam=gam, dqsdt=dqsdt) end if + call t_stopf('qsat_ice:CPU') end subroutine qsat_ice_line @@ -1164,10 +1195,13 @@ subroutine qsat_ice_vect(t, p, es, qs, vlen, gam, dqsdt, enthalpy) present_dqsdt = present(dqsdt) present_enthalpy = present(enthalpy) + call t_startf('qsat_ice:DTO') !$acc data copyin (t,p) & !$acc copyout (es,qs,gam,dqsdt,enthalpy) & !$acc create (hltalt,tterm) + call t_stopf('qsat_ice:DTO') + call t_startf('qsat_ice:ACCR') !$acc parallel vector_length(VLENS) default(present) !$acc loop gang vector do i = 1, vlen @@ -1194,8 +1228,11 @@ subroutine qsat_ice_vect(t, p, es, qs, vlen, gam, dqsdt, enthalpy) gam=gam, dqsdt=dqsdt) end if + call t_stopf('qsat_ice:ACCR') + call t_startf('qsat_ice:DTO') !$acc end data + call t_stopf('qsat_ice:DTO') end subroutine qsat_ice_vect subroutine qsat_ice_2D(t, p, es, qs, dim1, dim2, gam, dqsdt, enthalpy) @@ -1232,10 +1269,13 @@ subroutine qsat_ice_2D(t, p, es, qs, dim1, dim2, gam, dqsdt, enthalpy) present_dqsdt = present(dqsdt) present_enthalpy = present(enthalpy) + call t_stopf('qsat_ice:DTO') !$acc data copyin (t,p) & !$acc copyout (es,qs,gam,dqsdt,enthalpy) & !$acc create (hltalt,tterm) + call t_stopf('qsat_ice:DTO') + call t_startf('qsat_ice:ACCR') !$acc parallel vector_length(VLENS) default(present) !$acc loop gang vector collapse(2) do k = 1, dim2 @@ -1266,8 +1306,11 @@ subroutine qsat_ice_2D(t, p, es, qs, dim1, dim2, gam, dqsdt, enthalpy) gam=gam, dqsdt=dqsdt) end if + call t_stopf('qsat_ice:ACCR') + call t_startf('qsat_ice:DTO') !$acc end data + call t_stopf('qsat_ice:DTO') end subroutine qsat_ice_2D !--------------------------------------------------------------------- diff --git a/src/physics/cam/zm_conv_intr.F90 b/src/physics/cam/zm_conv_intr.F90 index d559ce4be4..4113c33a4b 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 @@ -53,9 +52,7 @@ module zm_conv_intr zm_ideep_idx, & dp_flxprc_idx, & dp_flxsnw_idx, & - dp_cldliq_idx, & ixorg, & - dp_cldice_idx, & dlfzm_idx, & ! detrained convective cloud water mixing ratio. difzm_idx, & ! detrained convective cloud ice mixing ratio. dnlfzm_idx, & ! detrained convective cloud water num concen. @@ -136,12 +133,6 @@ subroutine zm_conv_register ! Flux of snow from deep convection (kg/m2/s) call pbuf_add_field('DP_FLXSNW','global',dtype_r8,(/pcols,pverp/),dp_flxsnw_idx) -! deep gbm cloud liquid water (kg/kg) - call pbuf_add_field('DP_CLDLIQ','global',dtype_r8,(/pcols,pver/), dp_cldliq_idx) - -! deep gbm cloud liquid water (kg/kg) - call pbuf_add_field('DP_CLDICE','global',dtype_r8,(/pcols,pver/), dp_cldice_idx) - call pbuf_add_field('ICWMRDP', 'physpkg',dtype_r8,(/pcols,pver/),icwmrdp_idx) call pbuf_add_field('RPRDDP', 'physpkg',dtype_r8,(/pcols,pver/),rprddp_idx) call pbuf_add_field('NEVAPR_DPCU','physpkg',dtype_r8,(/pcols,pver/),nevapr_dpcu_idx) @@ -248,6 +239,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 +348,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 +378,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 +410,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 @@ -441,8 +451,6 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & real(r8), pointer, dimension(:,:) :: evapcdp ! Evaporation of deep convective precipitation real(r8), pointer, dimension(:,:) :: flxprec ! Convective-scale flux of precip at interfaces (kg/m2/s) real(r8), pointer, dimension(:,:) :: flxsnow ! Convective-scale flux of snow at interfaces (kg/m2/s) - real(r8), pointer, dimension(:,:) :: dp_cldliq - real(r8), pointer, dimension(:,:) :: dp_cldice real(r8), pointer :: dlf(:,:) ! detrained convective cloud water mixing ratio. real(r8), pointer :: dif(:,:) ! detrained convective cloud ice mixing ratio. real(r8), pointer :: dnlf(:,:) ! detrained convective cloud water num concen. @@ -474,12 +482,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 +513,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 +570,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 +595,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,:), & + ztodt, mcon(:ncol,:), cme(:ncol,:), cape(: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 +616,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 @@ -683,10 +699,6 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & call pbuf_get_field(pbuf, dp_flxprc_idx, flxprec ) call pbuf_get_field(pbuf, dp_flxsnw_idx, flxsnow ) - call pbuf_get_field(pbuf, dp_cldliq_idx, dp_cldliq ) - call pbuf_get_field(pbuf, dp_cldice_idx, dp_cldice ) - dp_cldliq(:ncol,:) = 0._r8 - dp_cldice(:ncol,:) = 0._r8 !REMOVECAM - no longer need these when CAM is retired and pcols no longer exists flxprec(:,:) = 0._r8 flxsnow(:,:) = 0._r8 @@ -740,72 +752,67 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & call physics_update(state1, ptend_loc, ztodt) - ! Momentum Transport (non-cam3 physics) - - if ( .not. cam_physpkg_is('cam3')) then - - 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. + ! Momentum Transport - call t_startf ('zm_conv_momtran_run') + call physics_ptend_init(ptend_loc, state1%psetcols, 'zm_conv_momtran_run', ls=.true., lu=.true., lv=.true.) -!REMOVECAM - no longer need this when CAM is retired and pcols no longer exists - wind_tends(:,:,:) = 0._r8 + 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 zm_conv_momtran_run (ncol, pver, pverp, & - l_windt,winds(:ncol,:,:), 2, mu(:ncol,:), md(:ncol,:), & + call t_startf ('zm_conv_momtran_run') + + call zm_conv_momtran_run (ncol, pver, pverp, & + 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,:) ) - call t_stopf ('zm_conv_momtran_run') + 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) + ptend_loc%s(:ncol,:pver) = seten(:ncol,:pver) - call physics_ptend_sum(ptend_loc,ptend_all, ncol) + call physics_ptend_sum(ptend_loc,ptend_all, ncol) - ! update physics state type state1 with ptend_loc - call physics_update(state1, ptend_loc, ztodt) + ! 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) - ftem(:ncol,:pver) = seten(:ncol,:pver)/cpair - if (zmconv_org) then - call outfld('ZM_ORG', state%q(:,:,ixorg), pcols, lchnk) - 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) - - ! 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) + ! update physics state type state1 with ptend_loc + call physics_update(state1, ptend_loc, ztodt) - end if + ftem(:ncol,:pver) = seten(:ncol,:pver)/cpair + if (zmconv_org) then + call outfld('ZM_ORG', state%q(:,:,ixorg), pcols, lchnk) + call outfld('ZM_ORG2D', zm_org2d, pcols, lchnk) + endif + call outfld('ZMMTT', ftem , pcols, lchnk) + + ! Output apparent force from pressure gradient + 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', icwuu, pcols, lchnk) + call outfld('ZMICUD', icwdu, pcols, lchnk) + call outfld('ZMICVU', icwuv, pcols, lchnk) + call outfld('ZMICVD', icwdv, pcols, lchnk) - ! Transport cloud water and ice only - call cnst_get_ind('CLDLIQ', ixcldliq) - call cnst_get_ind('CLDICE', ixcldice) + ! Transport cloud water and ice only + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) - lq(:) = .FALSE. - lq(2:) = cnst_is_convtran1(2:) - call physics_ptend_init(ptend_loc, state1%psetcols, 'convtran1', lq=lq) + lq(:) = .FALSE. + lq(2:) = cnst_is_convtran1(2:) + call physics_ptend_init(ptend_loc, state1%psetcols, 'convtran1', lq=lq) ! dpdry is not used in this call to convtran since the cloud liquid and ice mixing @@ -822,7 +829,7 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & ptend_loc%lq,state1%q(:ncol,:,:), pcnst, mu(:ncol,:), md(:ncol,:), & du(:ncol,:), eu(:ncol,:), ed(:ncol,:), dp(:ncol,:), dsubcld(:ncol), & jt(:ncol), maxg(:ncol), ideep(:ncol), 1, lengath, & - nstep, fracis(:ncol,:,:), ptend_loc%q(:ncol,:,:), fake_dpdry(:ncol,:), ztodt) + nstep, fracis(:ncol,:,:), ptend_loc%q(:ncol,:,:), fake_dpdry(:ncol,:)) call t_stopf ('convtran1') call outfld('ZMDICE ',ptend_loc%q(1,1,ixcldice) ,pcols ,lchnk ) @@ -922,7 +929,7 @@ subroutine zm_conv_tend_2( state, ptend, ztodt, pbuf) ptend%lq,state%q(:ncol,:,:), pcnst, mu(:ncol,:), md(:ncol,:), & du(:ncol,:), eu(:ncol,:), ed(:ncol,:), dp(:ncol,:), dsubcld(:ncol), & jt(:ncol), maxg(:ncol), ideep(:ncol), 1, lengath, & - nstep, fracis(:ncol,:,:), ptend%q(:ncol,:,:), dpdry(:ncol,:), ztodt) + nstep, fracis(:ncol,:,:), ptend%q(:ncol,:,:), dpdry(:ncol,:)) call t_stopf ('convtran2') 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 96% rename from src/physics/cam_dev/micro_pumas_cam.F90 rename to src/physics/cam7/micro_pumas_cam.F90 index 7c38333e95..788bdd438c 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') @@ -1471,6 +1483,7 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) use tropopause, only: tropopause_find, TROP_ALG_CPP, TROP_ALG_NONE, NOTFOUND use wv_saturation, only: qsat use infnan, only: nan, assignment(=) + use perf_mod, only: t_startf, t_stopf use cam_abortutils, only: handle_allocate_error use stochastic_tau_cam, only: ncd @@ -1653,6 +1666,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 +1900,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 @@ -1895,6 +1939,7 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) nan_array = nan + call t_startf('micro_pumas_cam_tend:NAR') ! Allocate the proc_rates DDT ! IMPORTANT NOTE -- elements in proc_rates are dimensioned to the nlev dimension while ! all the other arrays in this routine are dimensioned pver. This is required because @@ -1931,6 +1976,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 +2177,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 +2287,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 @@ -2280,9 +2373,11 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) frzimm(:ncol,:top_lev-1)=0._r8 frzcnt(:ncol,:top_lev-1)=0._r8 frzdep(:ncol,:top_lev-1)=0._r8 + call t_stopf('micro_pumas_cam_tend:NAR') do it = 1, num_steps + call t_startf('micro_pumas_cam_tend:micro_pumas_tend') call micro_pumas_tend( & ncol, nlev, dtime/num_steps,& state_loc%t(:ncol,top_lev:), state_loc%q(:ncol,top_lev:,ixq), & @@ -2333,6 +2428,8 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) tnd_qsnow(:ncol,top_lev:),tnd_nsnow(:ncol,top_lev:),re_ice(:ncol,top_lev:),& prer_evap(:ncol,top_lev:), & frzimm(:ncol,top_lev:), frzcnt(:ncol,top_lev:), frzdep(:ncol,top_lev:) ) + call t_stopf('micro_pumas_cam_tend:micro_pumas_tend') + call t_startf('micro_pumas_cam_tend:NAR') call handle_errmsg(errstring, subname="micro_pumas_cam_tend") @@ -2382,9 +2479,11 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) proc_rates%ank(:ncol,:,:) = proc_rates%ank(:ncol,:,:)/num_steps proc_rates%amk_out(:ncol,:,:) = proc_rates%amk_out(:ncol,:,:)/num_steps end if + call t_stopf('micro_pumas_cam_tend:NAR') end do + call t_startf('micro_pumas_cam_tend:NAR') ! Divide ptend by substeps. call physics_ptend_scale(ptend, 1._r8/num_steps, ncol) @@ -2844,6 +2943,7 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) else rho_grid = rho end if + call t_stopf('micro_pumas_cam_tend:NAR') ! Effective radius for cloud liquid, fixed number. mu_grid = 0._r8 @@ -2853,15 +2953,22 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) ncic_grid = 1.e8_r8 do k = top_lev, pver + call t_startf('micro_pumas_cam_tend:DTO'); !$acc data copyin (mg_liq_props,icwmrst_grid(:ngrdcol,k),rho_grid(:ngrdcol,k)) & !$acc copy (ncic_grid(:ngrdcol,k)) & !$acc copyout (mu_grid(:ngrdcol,k),lambdac_grid(:ngrdcol,k)) + call t_stopf('micro_pumas_cam_tend:DTO'); + call t_startf('micro_pumas_cam_tend:ACCR'); call size_dist_param_liq(mg_liq_props, icwmrst_grid(:ngrdcol,k), & ncic_grid(:ngrdcol,k), rho_grid(:ngrdcol,k), & mu_grid(:ngrdcol,k), lambdac_grid(:ngrdcol,k), ngrdcol) + call t_stopf('micro_pumas_cam_tend:ACCR'); + call t_startf('micro_pumas_cam_tend:DTO'); !$acc end data + call t_stopf('micro_pumas_cam_tend:DTO'); end do + call t_startf('micro_pumas_cam_tend:NAR') where (icwmrst_grid(:ngrdcol,top_lev:) > qsmall) rel_fn_grid(:ngrdcol,top_lev:) = & (mu_grid(:ngrdcol,top_lev:) + 3._r8)/ & @@ -2877,17 +2984,25 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) ! Calculate ncic on the grid ncic_grid(:ngrdcol,top_lev:) = nc_grid(:ngrdcol,top_lev:) / & max(mincld,liqcldf_grid(:ngrdcol,top_lev:)) + call t_stopf('micro_pumas_cam_tend:NAR') do k = top_lev, pver + call t_startf('micro_pumas_cam_tend:DTO'); !$acc data copyin (mg_liq_props,icwmrst_grid(:ngrdcol,k), rho_grid(:ngrdcol,k)) & !$acc copy (ncic_grid(:ngrdcol,k)) & !$acc copyout (mu_grid(:ngrdcol,k),lambdac_grid(:ngrdcol,k)) + call t_stopf('micro_pumas_cam_tend:DTO'); + call t_startf('micro_pumas_cam_tend:ACCR'); call size_dist_param_liq(mg_liq_props, icwmrst_grid(:ngrdcol,k), & ncic_grid(:ngrdcol,k), rho_grid(:ngrdcol,k), & mu_grid(:ngrdcol,k), lambdac_grid(:ngrdcol,k), ngrdcol) + call t_stopf('micro_pumas_cam_tend:ACCR'); + call t_startf('micro_pumas_cam_tend:DTO'); !$acc end data + call t_stopf('micro_pumas_cam_tend:DTO'); end do + call t_startf('micro_pumas_cam_tend:NAR') where (icwmrst_grid(:ngrdcol,top_lev:) >= qsmall) rel_grid(:ngrdcol,top_lev:) = & (mu_grid(:ngrdcol,top_lev:) + 3._r8) / & @@ -2953,16 +3068,24 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) niic_grid(:ngrdcol,top_lev:) = ni_grid(:ngrdcol,top_lev:) / & max(mincld,icecldf_grid(:ngrdcol,top_lev:)) + call t_stopf('micro_pumas_cam_tend:NAR') do k = top_lev, pver + call t_startf('micro_pumas_cam_tend:DTO'); !$acc data copyin (mg_ice_props, icimrst_grid(:ngrdcol,k)) & !$acc copy (niic_grid(:ngrdcol,k)) & !$acc copyout (rei_grid(:ngrdcol,k)) + call t_stopf('micro_pumas_cam_tend:DTO'); + call t_startf('micro_pumas_cam_tend:ACCR'); call size_dist_param_basic(mg_ice_props,icimrst_grid(:ngrdcol,k), & niic_grid(:ngrdcol,k),rei_grid(:ngrdcol,k),ngrdcol) + call t_stopf('micro_pumas_cam_tend:ACCR'); + call t_startf('micro_pumas_cam_tend:DTO'); !$acc end data + call t_stopf('micro_pumas_cam_tend:DTO'); end do + call t_startf('micro_pumas_cam_tend:NAR') where (icimrst_grid(:ngrdcol,top_lev:) >= qsmall) rei_grid(:ngrdcol,top_lev:) = 1.5_r8/rei_grid(:ngrdcol,top_lev:) & * 1.e6_r8 @@ -3090,6 +3213,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 ! ! --------------------- ! @@ -3511,6 +3691,7 @@ subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) if (qsatfac_idx <= 0) then deallocate(qsatfac) end if + call t_stopf('micro_pumas_cam_tend:NAR') end subroutine micro_pumas_cam_tend diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam7/physpkg.F90 similarity index 95% rename from src/physics/cam_dev/physpkg.F90 rename to src/physics/cam7/physpkg.F90 index 46805c150e..e64ce96b8c 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 @@ -93,6 +94,8 @@ module physpkg integer :: dqcore_idx = 0 ! dqcore index in physics buffer integer :: cmfmczm_idx = 0 ! Zhang-McFarlane convective mass fluxes integer :: rliqbc_idx = 0 ! tphysbc reserve liquid + integer :: psl_idx = 0 + !======================================================================= contains !======================================================================= @@ -761,7 +764,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use clubb_intr, only: clubb_ini_cam use tropopause, only: tropopause_init use solar_data, only: solar_data_init - use dadadj_cam, only: dadadj_init + use dadadj_cam, only: dadadj_cam_init use cam_abortutils, only: endrun use nudging, only: Nudge_Model, nudging_init use cam_snapshot, only: cam_snapshot_init @@ -887,7 +890,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) @@ -920,7 +923,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) call metdata_phys_init() #endif call tropopause_init() - call dadadj_init() + call dadadj_cam_init() prec_dp_idx = pbuf_get_index('PREC_DP') snow_dp_idx = pbuf_get_index('SNOW_DP') @@ -1036,6 +1039,8 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) dtcore_idx = pbuf_get_index('DTCORE') dqcore_idx = pbuf_get_index('DQCORE') + psl_idx = pbuf_get_index('PSL') + end subroutine phys_init ! @@ -1054,9 +1059,7 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) use check_energy, only: check_energy_gmean use spmd_utils, only: mpicom use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_allocate -#if (defined BFB_CAM_SCAM_IOP ) - use cam_history, only: outfld -#endif + use cam_history, only: outfld, write_camiop use cam_abortutils, only: endrun #if ( defined OFFLINE_DYN ) use metdata, only: get_met_srf1 @@ -1124,11 +1127,11 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) !----------------------------------------------------------------------- ! -#if (defined BFB_CAM_SCAM_IOP ) - do c=begchunk, endchunk - call outfld('Tg',cam_in(c)%ts,pcols ,c ) - end do -#endif + if (write_camiop) then + do c=begchunk, endchunk + call outfld('Tg',cam_in(c)%ts,pcols ,c ) + end do + end if call t_barrierf('sync_bc_physics', mpicom) call t_startf ('bc_physics') @@ -1399,7 +1402,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 @@ -1634,7 +1637,7 @@ subroutine tphysac (ztodt, cam_in, & !=================================================== ! Apply tracer surface fluxes to lowest model layer !=================================================== - call t_startf('clubb_emissions_tend') + call t_startf('tphysac:clubb_emissions_tend') call clubb_emissions_cam(state, cam_in, ptend) @@ -1642,7 +1645,7 @@ subroutine tphysac (ztodt, cam_in, & call check_energy_chng(state, tend, "clubb_emissions_tend", nstep, ztodt, zero, zero, zero, zero) - call t_stopf('clubb_emissions_tend') + call t_stopf('tphysac:clubb_emissions_tend') !=================================================== ! Calculate tendencies from CARMA bin microphysics. @@ -1657,9 +1660,9 @@ subroutine tphysac (ztodt, cam_in, & ! ! Currently CARMA cloud microphysics is only supported with the MG ! microphysics. - call t_startf('carma_timestep_tend') if (carma_do_cldice .or. carma_do_cldliq) then + call t_startf('tphysac:carma_timestep_tend') call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, dlf=dlf, rliq=rliq, & prec_str=prec_str, snow_str=snow_str, prec_sed=prec_sed_carma, snow_sed=snow_sed_carma) call physics_update(state, ptend, ztodt, tend) @@ -1672,9 +1675,9 @@ subroutine tphysac (ztodt, cam_in, & else call check_energy_chng(state, tend, "carma_tend", nstep, ztodt, zero, prec_str, snow_str, zero) end if + call t_stopf('tphysac:carma_timestep_tend') end if - call t_stopf('carma_timestep_tend') if( microp_scheme == 'MG' ) then ! Start co-substepping of macrophysics and microphysics @@ -1703,7 +1706,7 @@ subroutine tphysac (ztodt, cam_in, & ! Calculate macrophysical tendency (sedimentation, detrain, cloud fraction) !=================================================== - call t_startf('macrop_tend') + call t_startf('tphysac:clubb_tend_cam') ! ===================================================== ! CLUBB call (PBL, shallow convection, macrophysics) @@ -1717,6 +1720,7 @@ subroutine tphysac (ztodt, cam_in, & call clubb_tend_cam(state, ptend, pbuf, cld_macmic_ztodt,& cmfmc, cam_in, macmic_it, cld_macmic_num_steps, & dlf, det_s, det_ice) + call t_stopf('tphysac:clubb_tend_cam') ! Since we "added" the reserved liquid back in this routine, we need ! to account for it in the energy checker @@ -1751,7 +1755,6 @@ subroutine tphysac (ztodt, cam_in, & det_ice(:ncol)/cld_macmic_num_steps, & flx_heat(:ncol)/cld_macmic_num_steps) - call t_stopf('macrop_tend') !=================================================== ! Calculate cloud microphysics @@ -1779,9 +1782,9 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) end if - call t_startf('microp_aero_run') + call t_startf('tphysac:microp_aero_run') call microp_aero_run(state, ptend_aero, cld_macmic_ztodt, pbuf) - call t_stopf('microp_aero_run') + call t_stopf('tphysac:microp_aero_run') call t_startf('microp_tend') @@ -1853,7 +1856,9 @@ subroutine tphysac (ztodt, cam_in, & call physics_tend_dealloc(tend_sc) call physics_ptend_dealloc(ptend_sc) else + call t_startf('tphysac:microp_driver_tend') call microp_driver_tend(state, ptend, cld_macmic_ztodt, pbuf) + call t_stopf('tphysac:microp_driver_tend') end if ! combine aero and micro tendencies for the grid call physics_ptend_sum(ptend_aero, ptend, ncol) @@ -1921,10 +1926,30 @@ 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 t_startf('tphysac:modal_aero_calcsize_sub') + call modal_aero_calcsize_sub(state, ptend, ztodt, pbuf) + call t_stopf('tphysac:modal_aero_calcsize_sub') + ! for prognostic modal aerosols the transfer of mass between aitken and accumulation + ! modes is done in conjunction with the dry radius calculation + call t_startf('tphysac:modal_aero_wateruptake') + call modal_aero_wateruptake_dr(state, pbuf) + call t_stopf('tphysac:modal_aero_wateruptake') + call physics_update(state, ptend, ztodt, tend) + else + call t_startf('tphysac:modal_aero_calcsize_diag') + call modal_aero_calcsize_diag(state, pbuf) + call t_stopf('tphysac:modal_aero_calcsize_diag') + call t_startf('tphysac:modal_aero_wateruptake') + call modal_aero_wateruptake_dr(state, pbuf) + call t_stopf('tphysac:modal_aero_wateruptake') + endif endif if (trim(cam_take_snapshot_before) == "aero_model_wetdep") then @@ -1932,7 +1957,9 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) end if + call t_startf('tphysac:aero_model_wetdep') call aero_model_wetdep( state, ztodt, dlf, cam_out, ptend, pbuf) + call t_stopf('tphysac:aero_model_wetdep') if ( (trim(cam_take_snapshot_after) == "aero_model_wetdep") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) @@ -1952,21 +1979,21 @@ subroutine tphysac (ztodt, cam_in, & ! fields have already been set for CAM aerosols and cam_out can be ! added ! to for CARMA aerosols. - call t_startf ('carma_wetdep_tend') + call t_startf ('tphysac:carma_wetdep_tend') call carma_wetdep_tend(state, ptend, ztodt, pbuf, dlf, cam_out) call physics_update(state, ptend, ztodt, tend) - call t_stopf ('carma_wetdep_tend') + call t_stopf ('tphysac:carma_wetdep_tend') end if - call t_startf ('convect_deep_tend2') + call t_startf ('tphysac:convect_deep_tend2') call convect_deep_tend_2( state, ptend, ztodt, pbuf ) call physics_update(state, ptend, ztodt, tend) - call t_stopf ('convect_deep_tend2') + call t_stopf ('tphysac:convect_deep_tend2') ! 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 @@ -2001,8 +2028,11 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) end if + + call t_startf('tphysac:radiation_tend') call radiation_tend( & state, ptend, pbuf, cam_out, cam_in, net_flx) + call t_stopf('tphysac:radiation_tend') ! Set net flux used by spectral dycores do i=1,ncol @@ -2032,14 +2062,15 @@ subroutine tphysac (ztodt, cam_in, & !=================================================== ! Source/sink terms for advected tracers. !=================================================== - call t_startf('adv_tracer_src_snk') ! Test tracers if (trim(cam_take_snapshot_before) == "aoa_tracers_timestep_tend") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) end if - call aoa_tracers_timestep_tend(state, ptend, cam_in%cflx, cam_in%landfrac, ztodt) + call t_startf('tphysac:aoa_tracers_timestep_tend') + call aoa_tracers_timestep_tend(state, ptend, ztodt) + call t_stopf('tphysac:aoa_tracers_timestep_tend') if ( (trim(cam_take_snapshot_after) == "aoa_tracers_timestep_tend") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) @@ -2056,7 +2087,9 @@ subroutine tphysac (ztodt, cam_in, & call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) end if + call t_startf('tphysac:co2_cycle_set_ptend') call co2_cycle_set_ptend(state, pbuf, ptend) + call t_stopf('tphysac:co2_cycle_set_ptend') if ( (trim(cam_take_snapshot_after) == "co2_cycle_set_ptend") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) @@ -2083,8 +2116,10 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) end if + call t_startf('tphysac:chem_timestep_tend') call chem_timestep_tend(state, ptend, cam_in, cam_out, ztodt, & pbuf, fh2o=fh2o) + call t_stopf('tphysac:chem_timestep_tend') if ( (trim(cam_take_snapshot_after) == "chem_timestep_tend") .and. & @@ -2101,28 +2136,30 @@ subroutine tphysac (ztodt, cam_in, & call check_tracers_chng(state, tracerint, "chem_timestep_tend", nstep, ztodt, & cam_in%cflx) end if - call t_stopf('adv_tracer_src_snk') !=================================================== ! Vertical diffusion/pbl calculation ! Call vertical diffusion (apply tracer emissions, molecular diffusion and pbl form drag) !=================================================== - call t_startf('vertical_diffusion_tend') if (trim(cam_take_snapshot_before) == "vertical_diffusion_section") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) end if + call t_startf('tphysac:vertical_diffusion_tend') call vertical_diffusion_tend (ztodt ,state , cam_in, & surfric ,obklen ,ptend ,ast ,pbuf ) + call t_stopf ('tphysac:vertical_diffusion_tend') !------------------------------------------ ! Call major diffusion for extended model !------------------------------------------ if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + call t_startf ('tphysac:waccmx_phys_mspd_tend') call waccmx_phys_mspd_tend (ztodt ,state ,ptend) + call t_stopf ('tphysac:waccmx_phys_mspd_tend') endif if ( (trim(cam_take_snapshot_after) == "vertical_diffusion_section") .and. & @@ -2142,12 +2179,11 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) end if - call t_stopf ('vertical_diffusion_tend') !=================================================== ! Rayleigh friction calculation !=================================================== - call t_startf('rayleigh_friction') + call t_startf('tphysac:rayleigh_friction') call rayleigh_friction_tend( ztodt, state, ptend) if ( ptend%lu ) then call outfld( 'UTEND_RAYLEIGH', ptend%u, pcols, lchnk) @@ -2156,7 +2192,7 @@ subroutine tphysac (ztodt, cam_in, & call outfld( 'VTEND_RAYLEIGH', ptend%v, pcols, lchnk) end if call physics_update(state, ptend, ztodt, tend) - call t_stopf('rayleigh_friction') + call t_stopf('tphysac:rayleigh_friction') if (do_clubb_sgs) then call check_energy_chng(state, tend, "vdiff", nstep, ztodt, zero, zero, zero, zero) @@ -2168,7 +2204,7 @@ subroutine tphysac (ztodt, cam_in, & call check_tracers_chng(state, tracerint, "vdiff", nstep, ztodt, cam_in%cflx) ! aerosol dry deposition processes - call t_startf('aero_drydep') + call t_startf('tphysac:aero_model_drydep') if (trim(cam_take_snapshot_before) == "aero_model_drydep") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& @@ -2187,7 +2223,7 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) end if - call t_stopf('aero_drydep') + call t_stopf('tphysac:aero_model_drydep') ! CARMA microphysics ! @@ -2201,12 +2237,12 @@ subroutine tphysac (ztodt, cam_in, & ! cam_out ! can be added to for CARMA aerosols. if (carma_do_aerosol) then - call t_startf('carma_timestep_tend') + call t_startf('tphysac:carma_timestep_tend') call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, obklen=obklen, ustar=surfric) call physics_update(state, ptend, ztodt, tend) call check_energy_chng(state, tend, "carma_tend", nstep, ztodt, zero, zero, zero, zero) - call t_stopf('carma_timestep_tend') + call t_stopf('tphysac:carma_timestep_tend') end if !--------------------------------------------------------------------------------- @@ -2217,7 +2253,7 @@ subroutine tphysac (ztodt, cam_in, & !=================================================== ! Gravity wave drag !=================================================== - call t_startf('gw_tend') + call t_startf('tphysac:gw_tend') if (trim(cam_take_snapshot_before) == "gw_tend") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& @@ -2246,7 +2282,7 @@ subroutine tphysac (ztodt, cam_in, & ! Check energy integrals call check_energy_chng(state, tend, "gwdrag", nstep, ztodt, zero, & zero, zero, flx_heat) - call t_stopf('gw_tend') + call t_stopf('tphysac:gw_tend') ! QBO relaxation @@ -2255,7 +2291,9 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) end if + call t_startf('tphysac:qbo_relax') call qbo_relax(state, pbuf, ptend) + call t_stopf('tphysac:qbo_relax') if ( (trim(cam_take_snapshot_after) == "qbo_relax") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) @@ -2277,7 +2315,9 @@ subroutine tphysac (ztodt, cam_in, & call check_energy_chng(state, tend, "qborelax", nstep, ztodt, zero, zero, zero, zero) ! Lunar tides + call t_startf('tphysac:lunar_tides_tend') call lunar_tides_tend( state, ptend ) + call t_stopf('tphysac:lunar_tides_tend') if ( ptend%lu ) then call outfld( 'UTEND_LUNART', ptend%u, pcols, lchnk) end if @@ -2289,7 +2329,7 @@ subroutine tphysac (ztodt, cam_in, & call check_energy_chng(state, tend, "lunar_tides", nstep, ztodt, zero, zero, zero, zero) ! Ion drag calculation - call t_startf ( 'iondrag' ) + call t_startf ( 'tphysac:iondrag' ) if (trim(cam_take_snapshot_before) == "iondrag_calc_section") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& @@ -2337,7 +2377,7 @@ subroutine tphysac (ztodt, cam_in, & ! Check energy integrals call check_energy_chng(state, tend, "iondrag", nstep, ztodt, zero, zero, zero, zero) - call t_stopf ( 'iondrag' ) + call t_stopf ( 'tphysac:iondrag' ) ! Update Nudging values, if needed !---------------------------------- @@ -2395,7 +2435,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,& @@ -2491,7 +2531,9 @@ subroutine tphysbc (ztodt, state, & use physics_types, only: physics_update, & physics_state_check, & dyn_te_idx - use cam_diagnostics, only: diag_conv_tend_ini, diag_conv, diag_export, diag_state_b4_phys_write + use physconst, only: rair, gravit + use cam_diagnostics, only: diag_conv_tend_ini, diag_export, diag_state_b4_phys_write + use cam_diagnostic_utils, only: cpslec use cam_history, only: outfld use constituents, only: qmin use air_composition, only: thermodynamic_active_species_liq_num,thermodynamic_active_species_liq_idx @@ -2543,7 +2585,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 @@ -2601,6 +2642,8 @@ subroutine tphysbc (ztodt, state, & type(check_tracers_data):: tracerint ! energy integrals and cummulative boundary fluxes real(r8) :: zero_tracers(pcols,pcnst) + real(r8), pointer :: psl(:) ! Sea Level Pressure + logical :: lq(pcnst) !----------------------------------------------------------------------- @@ -2731,11 +2774,11 @@ subroutine tphysbc (ztodt, state, & !=================================================== ! Dry adjustment !=================================================== - call t_startf('dry_adjustment') + call t_startf('tphysbc:dadadj_tend') 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,26 +2791,26 @@ 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') + call t_stopf('tphysbc:dadadj_tend') !=================================================== ! Moist convection !=================================================== call t_startf('moist_convection') - call t_startf ('convect_deep_tend') + call t_startf ('tphysbc:convect_deep_tend') 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,10 +2830,10 @@ 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') + call t_stopf('tphysbc:convect_deep_tend') call pbuf_get_field(pbuf, prec_dp_idx, prec_dp ) call pbuf_get_field(pbuf, snow_dp_idx, snow_dp ) @@ -2828,7 +2871,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, & @@ -2863,21 +2906,30 @@ subroutine tphysbc (ztodt, state, & ! Run wet deposition routines to intialize aerosols !=================================================== + call t_startf('tphysbc:modal_aero_calcsize') call modal_aero_calcsize_diag(state, pbuf) + call t_stopf('tphysbc:modal_aero_calcsize') + + call t_startf('tphysbc:modal_aero_wateruptake') call modal_aero_wateruptake_dr(state, pbuf) + call t_stopf('tphysbc:modal_aero_wateruptake') !=================================================== ! Radiation computations ! initialize fluxes only, do not update state !=================================================== + call t_startf('tphysbc:radiation_tend') call radiation_tend( & state, ptend, pbuf, cam_out, cam_in, net_flx) + call t_stopf('tphysbc:radiation_tend') end if ! Save atmospheric fields to force surface models call t_startf('cam_export') + call pbuf_get_field(pbuf, psl_idx, psl) + call cpslec(ncol, state%pmid, state%phis, state%ps, state%t, psl, gravit, rair) call cam_export (state,cam_out,pbuf) call t_stopf('cam_export') 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/camrt/radconstants.F90 b/src/physics/camrt/radconstants.F90 index c95c8d2154..f9faf308f1 100644 --- a/src/physics/camrt/radconstants.F90 +++ b/src/physics/camrt/radconstants.F90 @@ -1,7 +1,7 @@ module radconstants ! This module contains constants that are specific to the radiative transfer -! code used in the CAM3 model. +! code used in the CAM4 model. use shr_kind_mod, only: r8 => shr_kind_r8 use cam_abortutils, only: endrun diff --git a/src/physics/camrt/radlw.F90 b/src/physics/camrt/radlw.F90 index 62ec514ffc..befd69fbc9 100644 --- a/src/physics/camrt/radlw.F90 +++ b/src/physics/camrt/radlw.F90 @@ -435,11 +435,7 @@ subroutine radclwmx(lchnk ,ncol ,doabsems , & ntopcld = max(ntopcld, trop_cloud_top_lev) cldp(:ncol,1:ntopcld) = 0.0_r8 - if ( cam_physpkg_is('cam3')) then - cldp(:ncol,ntoplw:pver) = cld(:ncol,ntoplw:pver) - else - cldp(:ncol,ntopcld+1:pver) = cld(:ncol,ntopcld+1:pver) - end if + cldp(:ncol,ntopcld+1:pver) = cld(:ncol,ntopcld+1:pver) cldp(:ncol,pverp) = 0.0_r8 ! ! 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/rrtmg/aer_src/rrtmg_sw_init.f90 b/src/physics/rrtmg/aer_src/rrtmg_sw_init.f90 index d71fa2a897..fc2ec91a53 100644 --- a/src/physics/rrtmg/aer_src/rrtmg_sw_init.f90 +++ b/src/physics/rrtmg/aer_src/rrtmg_sw_init.f90 @@ -182,10 +182,6 @@ subroutine swdatinit ! = (9.8066)(86400)(1e-5)/(1.004) ! heatfac = 8.4391_r8 -! Modified values for consistency with CAM3: -! = (9.80616)(86400)(1e-5)/(1.00464) -! heatfac = 8.43339130434_r8 - ! Calculate heatfac directly from CAM constants: heatfac = grav * cday * 1.e-5_r8 / (cpair * 1.e-3_r8) 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 ed330240ce..a0de032eea 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -58,6 +58,7 @@ module radiation use string_utils, only: to_lower use cam_abortutils, only: endrun, handle_allocate_error use cam_logfile, only: iulog +use perf_mod, only: t_startf, t_stopf implicit none @@ -453,6 +454,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 +463,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 +478,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. @@ -1110,6 +1120,7 @@ subroutine radiation_tend( & if (dosw) then + call t_startf('radiation_tend:NAR:cloud_sw') ! Set cloud optical properties in cloud_sw object. call rrtmgp_set_cloud_sw( & state, pbuf, nlay, nday, idxday, & @@ -1118,6 +1129,7 @@ subroutine radiation_tend( & rd%tot_cld_vistau, rd%tot_icld_vistau, rd%liq_icld_vistau, & rd%ice_icld_vistau, rd%snow_icld_vistau, rd%grau_icld_vistau, & cld_tau_cloudsim, snow_tau_cloudsim, grau_tau_cloudsim ) + call t_stopf('radiation_tend:NAR:cloud_sw') if (write_output) then call radiation_output_cld(lchnk, rd) @@ -1149,19 +1161,28 @@ subroutine radiation_tend( & if (nday > 0) then ! Set gas volume mixing ratios for this call in gas_concs_sw. + call t_startf('radiation_tend:NAR:gases_sw') call rrtmgp_set_gases_sw( & icall, state, pbuf, nlay, nday, & idxday, gas_concs_sw) + call t_stopf('radiation_tend:NAR:gases_sw') + call t_startf('radiation_tend:DTO') ! 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) + call t_stopf('radiation_tend:DTO') + + call t_startf('radiation_tend:ACCR') errmsg = kdist_sw%gas_optics( & pmid_day, pint_day, t_day, gas_concs_sw, atm_optics_sw, & toa_flux) + call t_stopf('radiation_tend:ACCR') + call t_startf('radiation_tend:DTO') !$acc end data + call t_stopf('radiation_tend:DTO') call stop_on_err(errmsg, sub, 'kdist_sw%gas_optics') ! Scale the solar source @@ -1173,11 +1194,14 @@ subroutine radiation_tend( & ! Set SW aerosol optical properties in the aer_sw object. ! This call made even when no daylight columns because it does some ! diagnostic aerosol output. + call t_startf('radiation_tend:NAR:aer_sw') call rrtmgp_set_aer_sw( & icall, state, pbuf, nday, idxday, nnite, idxnite, aer_sw) + call t_stopf('radiation_tend:NAR:aer_sw') if (nday > 0) then + call t_startf('radiation_tend:DTO') !! ADDED by SS as part of RRTMGP data optimization !$acc data copyin(atm_optics_sw, toa_flux, & !$acc aer_sw, cloud_sw, & @@ -1188,7 +1212,9 @@ subroutine radiation_tend( & !$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) + call t_stopf('radiation_tend:DTO') + call t_startf('radiation_tend:ACCR') ! 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') @@ -1208,7 +1234,11 @@ 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') + call t_stopf('radiation_tend:ACCR') + + call t_startf('radiation_tend:DTO') !$acc end data + call t_stopf('radiation_tend:DTO') end if @@ -1239,10 +1269,12 @@ subroutine radiation_tend( & call stop_on_err(errmsg, sub, 'sources_lw%alloc') ! Set cloud optical properties in cloud_lw object. + call t_startf('radiation_tend:NAR:cloud_lw') call rrtmgp_set_cloud_lw( & state, pbuf, ncol, nlay, nlaycam, & cld, cldfsnow, cldfgrau, cldfprime, graupel_in_rad, & kdist_lw, cloud_lw, cld_lw_abs_cloudsim, snow_lw_abs_cloudsim, grau_lw_abs_cloudsim) + call t_stopf('radiation_tend:NAR:cloud_lw') ! Initialize object for gas concentrations errmsg = gas_concs_lw%init(gaslist_lc) @@ -1262,8 +1294,11 @@ subroutine radiation_tend( & if (active_calls(icall)) then ! Set gas volume mixing ratios for this call in gas_concs_lw. + call t_startf('radiation_tend:NAR:gases_lw') call rrtmgp_set_gases_lw(icall, state, pbuf, nlay, gas_concs_lw) + call t_stopf('radiation_tend:NAR:gases_lw') + call t_startf('radiation_tend:DTO') ! Compute the gas optics and Planck sources. !$acc data copyin(kdist_lw,pmid_rad,pint_rad,t_rad,t_sfc, & !$acc gas_concs_lw) & @@ -1272,15 +1307,25 @@ subroutine radiation_tend( & !$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) + call t_stopf('radiation_tend:DTO') + + call t_startf('radiation_tend:ACCR') 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') + call t_stopf('radiation_tend:ACCR') + + call t_startf('radiation_tend:DTO') !$acc end data + call t_stopf('radiation_tend:DTO') ! Set LW aerosol optical properties in the aer_lw object. + call t_startf('radiation_tend:NAR:aer_lw') call rrtmgp_set_aer_lw(icall, state, pbuf, aer_lw) + call t_stopf('radiation_tend:NAR:aer_lw') + call t_startf('radiation_tend:DTO') !! Added by SS as part of RRTMGP data optimization !$acc data copyin(atm_optics_lw, aer_lw, cloud_lw, & !$acc aer_lw%tau, & @@ -1293,6 +1338,8 @@ subroutine radiation_tend( & !$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) + call t_stopf('radiation_tend:DTO') + call t_startf('radiation_tend:ACCR') ! Increment the gas optics by the aerosol optics. @@ -1310,7 +1357,11 @@ 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') + call t_stopf('radiation_tend:ACCR') + + call t_startf('radiation_tend:DTO') !$acc end data + call t_stopf('radiation_tend:DTO') ! 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/spcam/crmclouds_camaerosols.F90 b/src/physics/spcam/crmclouds_camaerosols.F90 index 3d8f2e315f..43889eaeeb 100644 --- a/src/physics/spcam/crmclouds_camaerosols.F90 +++ b/src/physics/spcam/crmclouds_camaerosols.F90 @@ -739,7 +739,7 @@ subroutine crmclouds_convect_tend(state, ptend, ztodt, pbuf) ptend%lq,state%q(:ncol,:,:), pcnst, mu(:ncol,:), md(:ncol,:), & du(:ncol,:), eu(:ncol,:), ed(:ncol,:), dp(:ncol,:), dsubcld(:ncol), & jt(:ncol),maxg(:ncol),ideep(:ncol), 1, lengath, & - nstep, fracis(:ncol,:,:), ptend%q(:ncol,:,:), dpdry(:ncol,:), ztodt ) + nstep, fracis(:ncol,:,:), ptend%q(:ncol,:,:), dpdry(:ncol,:)) end subroutine crmclouds_convect_tend !===================================================================================================== 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/physics/cam/cpslec.F90 b/src/utils/cam_diagnostic_utils.F90 similarity index 55% rename from src/physics/cam/cpslec.F90 rename to src/utils/cam_diagnostic_utils.F90 index cb29dc29e7..7a6921904a 100644 --- a/src/physics/cam/cpslec.F90 +++ b/src/utils/cam_diagnostic_utils.F90 @@ -1,31 +1,34 @@ +module cam_diagnostic_utils -subroutine cpslec (ncol, pmid, phis, ps, t, psl, gravit, rair) +! Collection of routines used for diagnostic calculations. + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver + + +implicit none +private +save + +public :: & + cpslec ! compute sea level pressure + +!=============================================================================== +contains +!=============================================================================== + +subroutine cpslec(ncol, pmid, phis, ps, t, psl, gravit, rair) !----------------------------------------------------------------------- ! -! Purpose: -! Hybrid coord version: Compute sea level pressure for a latitude line +! Compute sea level pressure. ! -! Method: -! CCM2 hybrid coord version using ECMWF formulation -! Algorithm: See section 3.1.b in NCAR NT-396 "Vertical +! Uses ECMWF formulation Algorithm: See section 3.1.b in NCAR NT-396 "Vertical ! Interpolation and Truncation of Model-Coordinate Data ! -! Author: Stolen from the Processor by Erik Kluzek -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! !----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use ppgrid, only: pcols, pver - - implicit none - -!-----------------------------Arguments--------------------------------- + !-----------------------------Arguments--------------------------------- integer , intent(in) :: ncol ! longitude dimension real(r8), intent(in) :: pmid(pcols,pver) ! Atmospheric pressure (pascals) @@ -36,21 +39,19 @@ subroutine cpslec (ncol, pmid, phis, ps, t, psl, gravit, rair) real(r8), intent(in) :: rair ! gas constant for dry air real(r8), intent(out):: psl(pcols) ! Sea level pressures (pascals) -!----------------------------------------------------------------------- -!-----------------------------Parameters-------------------------------- + !-----------------------------Parameters-------------------------------- real(r8), parameter :: xlapse = 6.5e-3_r8 ! Temperature lapse rate (K/m) -!----------------------------------------------------------------------- -!-----------------------------Local Variables--------------------------- - integer i ! Loop index - real(r8) alpha ! Temperature lapse rate in terms of pressure ratio (unitless) - real(r8) Tstar ! Computed surface temperature - real(r8) TT0 ! Computed temperature at sea-level - real(r8) alph ! Power to raise P/Ps to get rate of increase of T with pressure - real(r8) beta ! alpha*phis/(R*T) term used in approximation of PSL -!----------------------------------------------------------------------- -! + !-----------------------------Local Variables--------------------------- + integer :: i ! Loop index + real(r8) :: alpha ! Temperature lapse rate in terms of pressure ratio (unitless) + real(r8) :: Tstar ! Computed surface temperature + real(r8) :: TT0 ! Computed temperature at sea-level + real(r8) :: alph ! Power to raise P/Ps to get rate of increase of T with pressure + real(r8) :: beta ! alpha*phis/(R*T) term used in approximation of PSL + !----------------------------------------------------------------------- + alpha = rair*xlapse/gravit do i=1,ncol if ( abs(phis(i)/gravit) < 1.e-4_r8 )then @@ -77,5 +78,8 @@ subroutine cpslec (ncol, pmid, phis, ps, t, psl, gravit, rair) end if enddo - return end subroutine cpslec + +!=============================================================================== + +end module cam_diagnostic_utils diff --git a/src/utils/cam_grid_support.F90 b/src/utils/cam_grid_support.F90 index de3cbb210b..48c33d4974 100644 --- a/src/utils/cam_grid_support.F90 +++ b/src/utils/cam_grid_support.F90 @@ -1655,7 +1655,7 @@ function cam_grid_get_areawt(id) result(wtvals) nullify(attrptr) gridind = get_cam_grid_index(id) if (gridind > 0) then - select case(cam_grids(gridind)%name) + select case(trim(cam_grids(gridind)%name)) case('GLL') wtname='area_weight_gll' case('EUL') 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