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/.github/workflows/fleximod_test.yaml b/.github/workflows/fleximod_test.yaml new file mode 100644 index 0000000000..8d4203e1d3 --- /dev/null +++ b/.github/workflows/fleximod_test.yaml @@ -0,0 +1,21 @@ +on: pull_request + +jobs: + fleximod-test: + runs-on: ubuntu-latest + strategy: + matrix: + # oldest supported and latest supported + python-version: ["3.7", "3.x"] + steps: + - id: checkout-CESM + uses: actions/checkout@v4 + - id: run-fleximod + run: | + $GITHUB_WORKSPACE/bin/git-fleximod update + $GITHUB_WORKSPACE/bin/git-fleximod test +# - name: Setup tmate session +# if: ${{ failure() }} +# uses: mxschmitt/action-tmate@v3 + + diff --git a/.gitmodules b/.gitmodules index a93aba501a..b74aac6f02 100644 --- a/.gitmodules +++ b/.gitmodules @@ -36,7 +36,7 @@ [submodule "atmos_phys"] path = src/atmos_phys url = https://github.com/ESCOMP/atmospheric_physics - fxtag = atmos_phys0_02_006 + fxtag = atmos_phys0_04_001 fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/ESCOMP/atmospheric_physics @@ -57,7 +57,7 @@ [submodule "hemco"] path = src/hemco url = https://github.com/ESCOMP/HEMCO_CESM.git - fxtag = hemco-cesm1_2_1_hemco3_6_3_cesm_rme + fxtag = hemco-cesm1_2_1_hemco3_6_3_cesm_rme01 fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/ESCOMP/HEMCO_CESM.git @@ -96,79 +96,72 @@ url = https://github.com/larson-group/clubb_release fxrequired = AlwaysRequired fxsparse = ../.clubb_sparse_checkout - fxtag = clubb_4ncar_20231115_5406350 + 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_001 +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_79 +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_0_49 +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.2 +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_cesm0.0.106 +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.0.246 +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 = cmeps0.14.67 +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.34 +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.0.19 +fxtag = share1.1.2 fxrequired = ToplevelRequired fxDONOTUSEurl = https://github.com/ESCOMP/CESM_share -[submodule "mct"] -path = libraries/mct -url = https://github.com/MCSclimate/MCT -fxtag = MCT_2.11.0 -fxrequired = ToplevelRequired -fxDONOTUSEurl = https://github.com/MCSclimate/MCT - [submodule "parallelio"] path = libraries/parallelio url = https://github.com/NCAR/ParallelIO @@ -179,14 +172,14 @@ fxDONOTUSEurl = https://github.com/NCAR/ParallelIO [submodule "cice"] path = components/cice url = https://github.com/ESCOMP/CESM_CICE -fxtag = cesm_cice6_5_0_10 +fxtag = cesm_cice6_5_0_12 fxrequired = ToplevelRequired -fxDONOTUSEurl = https://github.com/NCAR/ParallelIO +fxDONOTUSEurl = https://github.com/ESCOMP/CESM_CICE [submodule "clm"] path = components/clm url = https://github.com/ESCOMP/CTSM -fxtag = ctsm5.2.007 +fxtag = ctsm5.2.027 fxrequired = ToplevelRequired fxDONOTUSEurl = https://github.com/ESCOMP/CTSM @@ -196,4 +189,3 @@ 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/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/git_fleximod/cli.py b/.lib/git-fleximod/git_fleximod/cli.py index bc099fcbc0..b6f728f881 100644 --- a/.lib/git-fleximod/git_fleximod/cli.py +++ b/.lib/git-fleximod/git_fleximod/cli.py @@ -2,7 +2,7 @@ import argparse from git_fleximod import utils -__version__ = "0.7.7" +__version__ = "0.8.4" def find_root_dir(filename=".gitmodules"): """ finds the highest directory in tree @@ -26,7 +26,7 @@ def find_root_dir(filename=".gitmodules"): def get_parser(): description = """ - %(prog)s manages checking out groups of gitsubmodules with addtional support for Earth System Models + %(prog)s manages checking out groups of gitsubmodules with additional support for Earth System Models """ parser = argparse.ArgumentParser( description=description, formatter_class=argparse.RawDescriptionHelpFormatter diff --git a/.lib/git-fleximod/git_fleximod/git_fleximod.py b/.lib/git-fleximod/git_fleximod/git_fleximod.py index ca5f90622d..50e0ef83df 100755 --- a/.lib/git-fleximod/git_fleximod/git_fleximod.py +++ b/.lib/git-fleximod/git_fleximod/git_fleximod.py @@ -13,14 +13,14 @@ from git_fleximod import cli from git_fleximod.gitinterface import GitInterface from git_fleximod.gitmodules import GitModules -from configparser import NoOptionError +from git_fleximod.submodule import Submodule # logger variable is global logger = None def fxrequired_allowed_values(): - return ["ToplevelRequired", "ToplevelOptional", "AlwaysRequired", "AlwaysOptional"] + return ["ToplevelRequired", "ToplevelOptional", "AlwaysRequired", "AlwaysOptional", "TopLevelRequired", "TopLevelOptional"] def commandline_arguments(args=None): @@ -33,14 +33,9 @@ def commandline_arguments(args=None): # explicitly listing a component overrides the optional flag if options.optional or options.components: - fxrequired = [ - "ToplevelRequired", - "ToplevelOptional", - "AlwaysRequired", - "AlwaysOptional", - ] + fxrequired = fxrequired_allowed_values() else: - fxrequired = ["ToplevelRequired", "AlwaysRequired"] + fxrequired = ["ToplevelRequired", "AlwaysRequired", "TopLevelRequired"] action = options.action if not action: @@ -98,7 +93,8 @@ def submodule_sparse_checkout(root_dir, name, url, path, sparsefile, tag="master """ logger.info("Called sparse_checkout for {}".format(name)) rgit = GitInterface(root_dir, logger) - superroot = rgit.git_operation("rev-parse", "--show-superproject-working-tree") + superroot = git_toplevelroot(root_dir, logger) + if superroot: gitroot = superroot.strip() else: @@ -154,6 +150,8 @@ def submodule_sparse_checkout(root_dir, name, url, path, sparsefile, tag="master 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)) @@ -166,7 +164,9 @@ def submodule_sparse_checkout(root_dir, name, url, path, sparsefile, tag="master return with utils.pushd(sprep_repo): - shutil.copy(sparsefile, gitsparse) + if os.path.isfile(sparsefile): + shutil.copy(sparsefile, gitsparse) + # Finally checkout the repo sprepo_git.git_operation("fetch", "origin", "--tags") @@ -176,283 +176,82 @@ def submodule_sparse_checkout(root_dir, name, url, path, sparsefile, tag="master rgit.config_set_value(f'submodule "{name}"', "active", "true") rgit.config_set_value(f'submodule "{name}"', "url", url) - -def single_submodule_checkout( - root, name, path, url=None, tag=None, force=False, optional=False -): - """ - This function checks out a single git submodule. - - Parameters: - root (str): The root directory for the git operation. - name (str): The name of the submodule. - path (str): The path to the submodule. - url (str, optional): The URL of the submodule. Defaults to None. - tag (str, optional): The tag to checkout. Defaults to None. - force (bool, optional): If set to True, forces the checkout operation. Defaults to False. - optional (bool, optional): If set to True, the submodule is considered optional. Defaults to False. - - Returns: - None - """ - # function implementation... - git = GitInterface(root, logger) - repodir = os.path.join(root, path) - logger.info("Checkout {} into {}/{}".format(name, root, path)) - # if url is provided update to the new url - tmpurl = None - repo_exists = False - if os.path.exists(os.path.join(repodir, ".git")): - logger.info("Submodule {} already checked out".format(name)) - repo_exists = True - # Look for a .gitmodules file in the newly checkedout repo - if not repo_exists and 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 url.startswith("git@"): - tmpurl = url - url = url.replace("git@github.com:", "https://github.com/") - git.git_operation("clone", url, path) - smgit = GitInterface(repodir, 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(root, ".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(root, rootdotgit, "modules", 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", name, "--", url, path) - - if not repo_exists or not tmpurl: - git.git_operation("submodule", "update", "--init", "--", path) - - if os.path.exists(os.path.join(repodir, ".gitmodules")): - # recursively handle this checkout - print(f"Recursively checking out submodules of {name}") - gitmodules = GitModules(logger, confpath=repodir) - requiredlist = ["AlwaysRequired"] - if optional: - requiredlist.append("AlwaysOptional") - submodules_checkout(gitmodules, repodir, requiredlist, force=force) - if not os.path.exists(os.path.join(repodir, ".git")): - utils.fatal_error( - f"Failed to checkout {name} {repo_exists} {tmpurl} {repodir} {path}" - ) - - if tmpurl: - print(git.git_operation("restore", ".gitmodules")) - - return - -def add_remote(git, url): - remotes = git.git_operation("remote", "-v") - newremote = "newremote.00" - if url in remotes: - for line in remotes: - if url in line and "fetch" in line: - newremote = line.split()[0] - break - else: - i = 0 - while "newremote" in remotes: - i = i + 1 - newremote = f"newremote.{i:02d}" - git.git_operation("remote", "add", newremote, url) - return newremote - -def submodules_status(gitmodules, root_dir, toplevel=False): +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(): - path = gitmodules.get(name, "path") - tag = gitmodules.get(name, "fxtag") - url = gitmodules.get(name, "url") - required = gitmodules.get(name, "fxrequired") - level = required and "Toplevel" in required - if not path: - utils.fatal_error("No path found in .gitmodules for {}".format(name)) - newpath = os.path.join(root_dir, path) - logger.debug("newpath is {}".format(newpath)) - if not os.path.exists(os.path.join(newpath, ".git")): - rootgit = GitInterface(root_dir, logger) - # submodule commands use path, not name - url = url.replace("git@github.com:", "https://github.com/") - tags = rootgit.git_operation("ls-remote", "--tags", url) - result = rootgit.git_operation("submodule","status",newpath).split() - ahash = None - if result: - ahash = result[0][1:] - hhash = None - atag = None - needsupdate += 1 - if not toplevel and level: - continue - 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 tag and not hhash and htag.endswith(tag): - hhash = htag.split()[0] - if hhash and atag: - break - if tag and (ahash == hhash or atag == tag): - print(f"e {name:>20} not checked out, aligned at tag {tag}") - elif tag: - ahash = rootgit.git_operation( - "submodule", "status", "{}".format(path) - ).rstrip() - ahash = ahash[1 : len(tag) + 1] - if tag == ahash: - print(f"e {name:>20} not checked out, aligned at hash {ahash}") - else: - print( - f"e {name:>20} not checked out, out of sync at tag {atag}, expected tag is {tag}" - ) - testfails += 1 - else: - print(f"e {name:>20} has no fxtag defined in .gitmodules") - testfails += 1 - else: - with utils.pushd(newpath): - git = GitInterface(newpath, logger) - atag = git.git_operation("describe", "--tags", "--always").rstrip() - ahash = git.git_operation("rev-list", "HEAD").partition("\n")[0] - rurl = git.git_operation("ls-remote","--get-url").rstrip() - if rurl != url: - remote = add_remote(git, url) - git.git_operation("fetch", remote) - if tag and atag == tag: - print(f" {name:>20} at tag {tag}") - elif tag and ahash[: len(tag)] == tag: - print(f" {name:>20} at hash {ahash}") - elif atag == ahash: - print(f" {name:>20} at hash {ahash}") - elif tag: - print( - f"s {name:>20} {atag} {ahash} is out of sync with .gitmodules {tag}" - ) - testfails += 1 - needsupdate += 1 - else: - print( - f"e {name:>20} has no fxtag defined in .gitmodules, module at {atag}" - ) - testfails += 1 - - status = git.git_operation("status", "--ignore-submodules", "-uno") - if "nothing to commit" not in status: - localmods = localmods + 1 - print("M" + textwrap.indent(status, " ")) - + 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): - _, localmods, needsupdate = submodules_status(gitmodules, root_dir) - - if localmods and not force: - local_mods_output() - return - if needsupdate == 0: - return - for name in gitmodules.sections(): - fxtag = gitmodules.get(name, "fxtag") - path = gitmodules.get(name, "path") - url = gitmodules.get(name, "url") - logger.info( - "name={} path={} url={} fxtag={} requiredlist={} ".format( - name, os.path.join(root_dir, path), url, fxtag, requiredlist - ) - ) - - fxrequired = gitmodules.get(name, "fxrequired") - assert fxrequired in fxrequired_allowed_values() - rgit = GitInterface(root_dir, logger) - superroot = rgit.git_operation("rev-parse", "--show-superproject-working-tree") - - fxsparse = gitmodules.get(name, "fxsparse") - + 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 + and ((superroot and "Toplevel" in fxrequired) + or fxrequired not in requiredlist) ): - if "ToplevelOptional" == fxrequired: - print("Skipping optional component {}".format(name)) - continue - if fxsparse: - logger.debug( - "Callng submodule_sparse_checkout({}, {}, {}, {}, {}, {}".format( - root_dir, name, url, path, fxsparse, fxtag - ) - ) - submodule_sparse_checkout(root_dir, name, url, path, fxsparse, tag=fxtag) - else: - logger.info( - "Calling submodule_checkout({},{},{},{})".format( - root_dir, name, path, url - ) - ) - - single_submodule_checkout( - root_dir, - name, - path, - url=url, - tag=fxtag, - force=force, - optional=("AlwaysOptional" in requiredlist), - ) - - if os.path.exists(os.path.join(path, ".git")): - submoddir = os.path.join(root_dir, path) - with utils.pushd(submoddir): - git = GitInterface(submoddir, logger) - # first make sure the url is correct - upstream = git.git_operation("ls-remote", "--get-url").rstrip() - newremote = "origin" - if upstream != url: - add_remote(git, url) - - tags = git.git_operation("tag", "-l") - 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"{name:>20} updated to {fxtag}") - except Exception as error: - print(error) - elif not fxtag: - print(f"No fxtag found for submodule {name:>20}") - else: - print(f"{name:>20} up to date.") - + 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 = """\ @@ -467,62 +266,6 @@ def local_mods_output(): """ print(text) - -# checkout is done by update if required so this function may be depricated -def submodules_checkout(gitmodules, root_dir, requiredlist, force=False): - """ - This function checks out all git submodules based on the provided parameters. - - Parameters: - gitmodules (ConfigParser): The gitmodules configuration. - root_dir (str): The root directory for the git operation. - requiredlist (list): The list of required modules. - force (bool, optional): If set to True, forces the checkout operation. Defaults to False. - - Returns: - None - """ - # function implementation... - print("") - _, localmods, needsupdate = submodules_status(gitmodules, root_dir) - if localmods and not force: - local_mods_output() - return - if not needsupdate: - return - for name in gitmodules.sections(): - fxrequired = gitmodules.get(name, "fxrequired") - fxsparse = gitmodules.get(name, "fxsparse") - fxtag = gitmodules.get(name, "fxtag") - path = gitmodules.get(name, "path") - url = gitmodules.get(name, "url") - if fxrequired and fxrequired not in requiredlist: - if "Optional" in fxrequired: - print("Skipping optional component {}".format(name)) - continue - - if fxsparse: - logger.debug( - "Callng submodule_sparse_checkout({}, {}, {}, {}, {}, {}".format( - root_dir, name, url, path, fxsparse, fxtag - ) - ) - submodule_sparse_checkout(root_dir, name, url, path, fxsparse, tag=fxtag) - else: - logger.debug( - "Calling submodule_checkout({},{},{})".format(root_dir, name, path) - ) - single_submodule_checkout( - root_dir, - name, - path, - url=url, - tag=fxtag, - force=force, - optional="AlwaysOptional" in requiredlist, - ) - - def submodules_test(gitmodules, root_dir): """ This function tests the git submodules based on the provided parameters. @@ -545,7 +288,7 @@ def submodules_test(gitmodules, root_dir): # and that sparse checkout files exist for name in gitmodules.sections(): url = gitmodules.get(name, "url") - fxurl = gitmodules.get(name, "fxDONOTMODIFYurl") + fxurl = gitmodules.get(name, "fxDONOTUSEurl") fxsparse = gitmodules.get(name, "fxsparse") path = gitmodules.get(name, "path") fxurl = fxurl[:-4] if fxurl.endswith(".git") else fxurl diff --git a/.lib/git-fleximod/git_fleximod/gitinterface.py b/.lib/git-fleximod/git_fleximod/gitinterface.py index 93ae38ecde..5831201446 100644 --- a/.lib/git-fleximod/git_fleximod/gitinterface.py +++ b/.lib/git-fleximod/git_fleximod/gitinterface.py @@ -49,8 +49,14 @@ def _init_git_repo(self): # pylint: disable=unused-argument def git_operation(self, operation, *args, **kwargs): - command = self._git_command(operation, *args) - self.logger.info(command) + 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) @@ -62,7 +68,11 @@ def git_operation(self, operation, *args, **kwargs): def config_get_value(self, section, name): if self._use_module: config = self.repo.config_reader() - return config.get_value(section, name) + 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) diff --git a/.lib/git-fleximod/git_fleximod/gitmodules.py b/.lib/git-fleximod/git_fleximod/gitmodules.py index 7e4e05394a..cf8b350dd6 100644 --- a/.lib/git-fleximod/git_fleximod/gitmodules.py +++ b/.lib/git-fleximod/git_fleximod/gitmodules.py @@ -1,4 +1,4 @@ -import shutil +import shutil, os from pathlib import Path from configparser import RawConfigParser, ConfigParser from .lstripreader import LstripReader 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/.lib/git-fleximod/git_fleximod/utils.py b/.lib/git-fleximod/git_fleximod/utils.py index 7cc1de38cc..1a2d5ccf2f 100644 --- a/.lib/git-fleximod/git_fleximod/utils.py +++ b/.lib/git-fleximod/git_fleximod/utils.py @@ -241,12 +241,12 @@ def _hanging_msg(working_directory, command): 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. +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, diff --git a/.lib/git-fleximod/poetry.lock b/.lib/git-fleximod/poetry.lock index b59ed3942c..3a74effcd1 100644 --- a/.lib/git-fleximod/poetry.lock +++ b/.lib/git-fleximod/poetry.lock @@ -13,13 +13,13 @@ files = [ [[package]] name = "babel" -version = "2.14.0" +version = "2.15.0" description = "Internationalization utilities" optional = false -python-versions = ">=3.7" +python-versions = ">=3.8" files = [ - {file = "Babel-2.14.0-py3-none-any.whl", hash = "sha256:efb1a25b7118e67ce3a259bed20545c29cb68be8ad2c784c83689981b7a57287"}, - {file = "Babel-2.14.0.tar.gz", hash = "sha256:6919867db036398ba21eb5c7a0f6b28ab8cbc3ae7a73a44ebe34ae74a4e7d363"}, + {file = "Babel-2.15.0-py3-none-any.whl", hash = "sha256:08706bdad8d0a3413266ab61bd6c34d0c28d6e1e7badf40a2cebe67644e2e1fb"}, + {file = "babel-2.15.0.tar.gz", hash = "sha256:8daf0e265d05768bc6c7a314cf1321e9a123afc328cc635c18622a2f30a04413"}, ] [package.dependencies] @@ -30,13 +30,13 @@ dev = ["freezegun (>=1.0,<2.0)", "pytest (>=6.0)", "pytest-cov"] [[package]] name = "certifi" -version = "2024.2.2" +version = "2024.6.2" description = "Python package for providing Mozilla's CA Bundle." optional = false python-versions = ">=3.6" files = [ - {file = "certifi-2024.2.2-py3-none-any.whl", hash = "sha256:dc383c07b76109f368f6106eee2b593b04a011ea4d55f652c6ca24a754d1cdd1"}, - {file = "certifi-2024.2.2.tar.gz", hash = "sha256:0569859f95fc761b18b45ef421b1290a0f65f147e92a1e5eb3e635f9a5e4e66f"}, + {file = "certifi-2024.6.2-py3-none-any.whl", hash = "sha256:ddc6c8ce995e6987e7faf5e3f1b02b302836a0e5d98ece18392cb1a36c72ad56"}, + {file = "certifi-2024.6.2.tar.gz", hash = "sha256:3cd43f1c6fa7dedc5899d69d3ad0398fd018ad1a17fba83ddaf78aa46c747516"}, ] [[package]] @@ -162,13 +162,13 @@ files = [ [[package]] name = "exceptiongroup" -version = "1.2.0" +version = "1.2.1" description = "Backport of PEP 654 (exception groups)" optional = false python-versions = ">=3.7" files = [ - {file = "exceptiongroup-1.2.0-py3-none-any.whl", hash = "sha256:4bfd3996ac73b41e9b9628b04e079f193850720ea5945fc96a08633c66912f14"}, - {file = "exceptiongroup-1.2.0.tar.gz", hash = "sha256:91f5c769735f051a4290d52edd0858999b57e5876e9f85937691bd4c9fa3ed68"}, + {file = "exceptiongroup-1.2.1-py3-none-any.whl", hash = "sha256:5258b9ed329c5bbdd31a309f53cbfb0b155341807f6ff7606a1e801a891b29ad"}, + {file = "exceptiongroup-1.2.1.tar.gz", hash = "sha256:a4785e48b045528f5bfe627b6ad554ff32def154f42372786903b7abcfe1aa16"}, ] [package.extras] @@ -225,30 +225,31 @@ smmap = ">=3.0.1,<6" [[package]] name = "gitpython" -version = "3.1.41" +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.41-py3-none-any.whl", hash = "sha256:c36b6634d069b3f719610175020a9aed919421c87552185b085e04fbbdb10b7c"}, - {file = "GitPython-3.1.41.tar.gz", hash = "sha256:ed66e624884f76df22c8e16066d567aaa5a37d5b5fa19db2c6df6f7156db9048"}, + {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] -test = ["black", "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", "sumtypes"] +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.6" +version = "3.7" description = "Internationalized Domain Names in Applications (IDNA)" optional = false python-versions = ">=3.5" files = [ - {file = "idna-3.6-py3-none-any.whl", hash = "sha256:c05567e9c24a6b9faaa835c4821bad0590fbb9d5779e7caa6e1cc4978e7eb24f"}, - {file = "idna-3.6.tar.gz", hash = "sha256:9ecdbbd083b06798ae1e86adcbfe8ab1479cf864e4ee30fe4e46a003d12491ca"}, + {file = "idna-3.7-py3-none-any.whl", hash = "sha256:82fee1fc78add43492d3a1898bfa6d8a904cc97d8427f683ed8e798d07761aa0"}, + {file = "idna-3.7.tar.gz", hash = "sha256:028ff3aadf0609c1fd278d8ea3089299412a7a8b9bd005dd08b9f8285bcb5cfc"}, ] [[package]] @@ -264,22 +265,22 @@ files = [ [[package]] name = "importlib-metadata" -version = "7.0.1" +version = "8.0.0" description = "Read metadata from Python packages" optional = false python-versions = ">=3.8" files = [ - {file = "importlib_metadata-7.0.1-py3-none-any.whl", hash = "sha256:4805911c3a4ec7c3966410053e9ec6a1fecd629117df5adee56dfc9432a1081e"}, - {file = "importlib_metadata-7.0.1.tar.gz", hash = "sha256:f238736bb06590ae52ac1fab06a3a9ef1d8dce2b7a35b5ab329371d6c8f5d2cc"}, + {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] -docs = ["furo", "jaraco.packaging (>=9.3)", "jaraco.tidelift (>=1.4)", "rst.linker (>=1.9)", "sphinx (<7.2.5)", "sphinx (>=3.5)", "sphinx-lint"] +doc = ["furo", "jaraco.packaging (>=9.3)", "jaraco.tidelift (>=1.4)", "rst.linker (>=1.9)", "sphinx (>=3.5)", "sphinx-lint"] perf = ["ipython"] -testing = ["flufl.flake8", "importlib-resources (>=1.3)", "packaging", "pyfakefs", "pytest (>=6)", "pytest-black (>=0.3.7)", "pytest-checkdocs (>=2.4)", "pytest-cov", "pytest-enabler (>=2.2)", "pytest-mypy (>=0.9.1)", "pytest-perf (>=0.9.2)", "pytest-ruff"] +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" @@ -294,13 +295,13 @@ files = [ [[package]] name = "jinja2" -version = "3.1.3" +version = "3.1.4" description = "A very fast and expressive template engine." optional = false python-versions = ">=3.7" files = [ - {file = "Jinja2-3.1.3-py3-none-any.whl", hash = "sha256:7d6d50dd97d52cbc355597bd845fabfbac3f551e1f99619e39a35ce8c370b5fa"}, - {file = "Jinja2-3.1.3.tar.gz", hash = "sha256:ac8bd6544d4bb2c9792bf3a159e80bba8fda7f07e81bc3aed565432d5925ba90"}, + {file = "jinja2-3.1.4-py3-none-any.whl", hash = "sha256:bc5dd2abb727a5319567b7a813e6a2e7318c39f4f487cfe6c89c6f9c7d25197d"}, + {file = "jinja2-3.1.4.tar.gz", hash = "sha256:4a3aee7acbbe7303aede8e9648d13b8bf88a429282aa6122a993f0ac800cb369"}, ] [package.dependencies] @@ -380,24 +381,24 @@ files = [ [[package]] name = "packaging" -version = "23.2" +version = "24.1" description = "Core utilities for Python packages" optional = false -python-versions = ">=3.7" +python-versions = ">=3.8" files = [ - {file = "packaging-23.2-py3-none-any.whl", hash = "sha256:8c491190033a9af7e1d931d0b5dacc2ef47509b34dd0de67ed209b5203fc88c7"}, - {file = "packaging-23.2.tar.gz", hash = "sha256:048fb0e9405036518eaaf48a55953c750c11e1a1b68e0dd1a9d62ed0c092cfc5"}, + {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.4.0" +version = "1.5.0" description = "plugin and hook calling mechanisms for python" optional = false python-versions = ">=3.8" files = [ - {file = "pluggy-1.4.0-py3-none-any.whl", hash = "sha256:7db9f7b503d67d1c5b95f59773ebb58a8c1c288129a88665838012cfb07b8981"}, - {file = "pluggy-1.4.0.tar.gz", hash = "sha256:8c85c2876142a764e5b7548e7d9a0e0ddb46f5185161049a79b7e974454223be"}, + {file = "pluggy-1.5.0-py3-none-any.whl", hash = "sha256:44e1ad92c8ca002de6377e165f3e0f1be63266ab4d554740532335b9d75ea669"}, + {file = "pluggy-1.5.0.tar.gz", hash = "sha256:2cffa88e94fdc978c4c574f15f9e59b7f4201d439195c3715ca9e2486f1d0cf1"}, ] [package.extras] @@ -406,39 +407,38 @@ testing = ["pytest", "pytest-benchmark"] [[package]] name = "pyfakefs" -version = "5.3.5" +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.3.5-py3-none-any.whl", hash = "sha256:751015c1de94e1390128c82b48cdedc3f088bbdbe4bc713c79d02a27f0f61e69"}, - {file = "pyfakefs-5.3.5.tar.gz", hash = "sha256:7cdc500b35a214cb7a614e1940543acc6650e69a94ac76e30f33c9373bd9cf90"}, + {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.17.2" +version = "2.18.0" description = "Pygments is a syntax highlighting package written in Python." optional = false -python-versions = ">=3.7" +python-versions = ">=3.8" files = [ - {file = "pygments-2.17.2-py3-none-any.whl", hash = "sha256:b27c2826c47d0f3219f29554824c30c5e8945175d888647acd804ddd04af846c"}, - {file = "pygments-2.17.2.tar.gz", hash = "sha256:da46cec9fd2de5be3a8a784f434e4c4ab670b4ff54d605c4c2717e9d49c4c367"}, + {file = "pygments-2.18.0-py3-none-any.whl", hash = "sha256:b8e6aca0523f3ab76fee51799c488e38782ac06eafcf95e7ba832985c8e7b13a"}, + {file = "pygments-2.18.0.tar.gz", hash = "sha256:786ff802f32e91311bff3889f6e9a86e81505fe99f2735bb6d60ae0c5004f199"}, ] [package.extras] -plugins = ["importlib-metadata"] windows-terminal = ["colorama (>=0.4.6)"] [[package]] name = "pytest" -version = "8.0.0" +version = "8.2.2" description = "pytest: simple powerful testing with Python" optional = false python-versions = ">=3.8" files = [ - {file = "pytest-8.0.0-py3-none-any.whl", hash = "sha256:50fb9cbe836c3f20f0dfa99c565201fb75dc54c8d76373cd1bde06b06657bdb6"}, - {file = "pytest-8.0.0.tar.gz", hash = "sha256:249b1b0864530ba251b7438274c4d251c58d868edaaec8762893ad4a0d71c36c"}, + {file = "pytest-8.2.2-py3-none-any.whl", hash = "sha256:c434598117762e2bd304e526244f67bf66bbd7b5d6cf22138be51ff661980343"}, + {file = "pytest-8.2.2.tar.gz", hash = "sha256:de4bb8104e201939ccdc688b27a89a7be2079b22e2bd2b07f806b6ba71117977"}, ] [package.dependencies] @@ -446,11 +446,11 @@ colorama = {version = "*", markers = "sys_platform == \"win32\""} exceptiongroup = {version = ">=1.0.0rc8", markers = "python_version < \"3.11\""} iniconfig = "*" packaging = "*" -pluggy = ">=1.3.0,<2.0" -tomli = {version = ">=1.0.0", markers = "python_version < \"3.11\""} +pluggy = ">=1.5,<2.0" +tomli = {version = ">=1", markers = "python_version < \"3.11\""} [package.extras] -testing = ["argcomplete", "attrs (>=19.2.0)", "hypothesis (>=3.56)", "mock", "nose", "pygments (>=2.7.2)", "requests", "setuptools", "xmlschema"] +dev = ["argcomplete", "attrs (>=19.2)", "hypothesis (>=3.56)", "mock", "pygments (>=2.7.2)", "requests", "setuptools", "xmlschema"] [[package]] name = "pytz" @@ -465,13 +465,13 @@ files = [ [[package]] name = "requests" -version = "2.31.0" +version = "2.32.3" description = "Python HTTP for Humans." optional = false -python-versions = ">=3.7" +python-versions = ">=3.8" files = [ - {file = "requests-2.31.0-py3-none-any.whl", hash = "sha256:58cd2187c01e70e6e26505bca751777aa9f2ee0b7f4300988b709f44e013003f"}, - {file = "requests-2.31.0.tar.gz", hash = "sha256:942c5a758f98d790eaed1a29cb6eefc7ffb0d1cf7af05c3d2791656dbd6ad1e1"}, + {file = "requests-2.32.3-py3-none-any.whl", hash = "sha256:70761cfe03c773ceb22aa2f671b4757976145175cdfca038c02654d061d6dcc6"}, + {file = "requests-2.32.3.tar.gz", hash = "sha256:55365417734eb18255590a9ff9eb97e9e1da868d4ccd6402399eaf68af20a760"}, ] [package.dependencies] @@ -643,13 +643,13 @@ files = [ [[package]] name = "urllib3" -version = "2.2.0" +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.0-py3-none-any.whl", hash = "sha256:ce3711610ddce217e6d113a2732fafad960a03fd0318c91faa79481e35c11224"}, - {file = "urllib3-2.2.0.tar.gz", hash = "sha256:051d961ad0c62a94e50ecf1af379c3aba230c66c710493493560c0c223c49f20"}, + {file = "urllib3-2.2.2-py3-none-any.whl", hash = "sha256:a448b2f64d686155468037e1ace9f2d2199776e17f0a46610480d311f73e3472"}, + {file = "urllib3-2.2.2.tar.gz", hash = "sha256:dd505485549a7a552833da5e6063639d0d177c04f23bc3864e41e5dc5f612168"}, ] [package.extras] @@ -674,18 +674,18 @@ test = ["pytest (>=6.0.0)", "setuptools (>=65)"] [[package]] name = "zipp" -version = "3.17.0" +version = "3.19.2" description = "Backport of pathlib-compatible object wrapper for zip files" optional = false python-versions = ">=3.8" files = [ - {file = "zipp-3.17.0-py3-none-any.whl", hash = "sha256:0e923e726174922dce09c53c59ad483ff7bbb8e572e00c7f7c46b88556409f31"}, - {file = "zipp-3.17.0.tar.gz", hash = "sha256:84e64a1c28cf7e91ed2078bb8cc8c259cb19b76942096c8d7b84947690cabaf0"}, + {file = "zipp-3.19.2-py3-none-any.whl", hash = "sha256:f091755f667055f2d02b32c53771a7a6c8b47e1fdbc4b72a8b9072b3eef8015c"}, + {file = "zipp-3.19.2.tar.gz", hash = "sha256:bf1dcf6450f873a13e952a29504887c89e6de7506209e5b1bcc3460135d4de19"}, ] [package.extras] -docs = ["furo", "jaraco.packaging (>=9.3)", "jaraco.tidelift (>=1.4)", "rst.linker (>=1.9)", "sphinx (<7.2.5)", "sphinx (>=3.5)", "sphinx-lint"] -testing = ["big-O", "jaraco.functools", "jaraco.itertools", "more-itertools", "pytest (>=6)", "pytest-black (>=0.3.7)", "pytest-checkdocs (>=2.4)", "pytest-cov", "pytest-enabler (>=2.2)", "pytest-ignore-flaky", "pytest-mypy (>=0.9.1)", "pytest-ruff"] +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" diff --git a/.lib/git-fleximod/pyproject.toml b/.lib/git-fleximod/pyproject.toml index a316914bf5..850e57d59d 100644 --- a/.lib/git-fleximod/pyproject.toml +++ b/.lib/git-fleximod/pyproject.toml @@ -1,6 +1,6 @@ [tool.poetry] name = "git-fleximod" -version = "0.7.7" +version = "0.8.4" description = "Extended support for git-submodule and git-sparse-checkout" authors = ["Jim Edwards "] maintainers = ["Jim Edwards "] diff --git a/.lib/git-fleximod/tbump.toml b/.lib/git-fleximod/tbump.toml index c22637ccda..bd82c557ad 100644 --- a/.lib/git-fleximod/tbump.toml +++ b/.lib/git-fleximod/tbump.toml @@ -2,7 +2,7 @@ github_url = "https://github.com/jedwards4b/git-fleximod/" [version] -current = "0.7.7" +current = "0.8.4" # Example of a semver regexp. # Make sure this matches current_version before diff --git a/.lib/git-fleximod/tests/conftest.py b/.lib/git-fleximod/tests/conftest.py index 1cc008eb1d..81edbe713e 100644 --- a/.lib/git-fleximod/tests/conftest.py +++ b/.lib/git-fleximod/tests/conftest.py @@ -32,7 +32,7 @@ def logger(): "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", + "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"] @@ -119,8 +119,20 @@ def complex_repo(tmp_path, logger): 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", "main") - gitp.git_operation("checkout", "main") + 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 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/bld/build-namelist b/bld/build-namelist index c7a4c7857a..861beda5c2 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'); } @@ -1786,7 +1809,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' ); } @@ -2076,9 +2099,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 +2142,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,8 +2248,10 @@ 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); } @@ -2306,14 +2336,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 +2354,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 +2362,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 +2416,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', @@ -2405,7 +2441,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 +2546,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 +2651,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 +2755,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 +2846,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 +2908,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 +3156,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 @@ -3226,7 +3301,7 @@ 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 cam7 runs @@ -3674,19 +3749,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')) { @@ -3735,6 +3806,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.'); @@ -3788,6 +3863,7 @@ my $do_gw_front = ($nl->get_value('use_gw_front') =~ /$TRUE/io); my $do_gw_front_igw = ($nl->get_value('use_gw_front_igw') =~ /$TRUE/io); my $do_gw_convect_dp = ($nl->get_value('use_gw_convect_dp') =~ /$TRUE/io); my $do_gw_convect_sh = ($nl->get_value('use_gw_convect_sh') =~ /$TRUE/io); +my $do_gw_movmtn_pbl = ($nl->get_value('use_gw_movmtn_pbl') =~ /$TRUE/io); my $do_gw_rdg_beta = ($nl->get_value('use_gw_rdg_beta') =~ /$TRUE/io); my $do_gw_rdg_gamma = ($nl->get_value('use_gw_rdg_gamma') =~ /$TRUE/io); @@ -3845,6 +3921,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"; @@ -4040,6 +4121,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 @@ -4361,7 +4466,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); diff --git a/bld/config_files/definition.xml b/bld/config_files/definition.xml index 327f3d22ea..6a4a5436fb 100644 --- a/bld/config_files/definition.xml +++ b/bld/config_files/definition.xml @@ -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 adfafa5fea..8e21a98fd8 100755 --- a/bld/configure +++ b/bld/configure @@ -64,7 +64,7 @@ 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 ]. @@ -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: @@ -297,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'}, @@ -641,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); @@ -1203,15 +1210,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 } @@ -1225,10 +1242,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 } @@ -2185,6 +2202,7 @@ sub write_filepath 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 @@ -2324,6 +2342,7 @@ sub write_filepath #Add the CCPP'ized subdirectories 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 f94ab64353..e11f21e5a1 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -218,7 +218,13 @@ 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_FMTHIST_ne3pg3_mg37_L93_79-02-01_c240517.nc atm/cam/inic/homme/cami-mam3_0000-01_ne5np4_L30.140707.nc @@ -241,7 +247,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 @@ -316,7 +322,7 @@ 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 @@ -564,7 +570,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 @@ -842,6 +848,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 @@ -892,6 +899,7 @@ 1.0d-3 0.002d0 0.1d0 + 0.01d0 15 @@ -1989,6 +1997,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 @@ -2238,6 +2248,7 @@ .false. .true. .true. + .true. 0.2 @@ -2263,6 +2274,7 @@ 10.0 4.0 0.0 + 5.0 .true. .false. @@ -2281,6 +2293,8 @@ .false. .false. .false. + 0.5 + 25.00 @@ -2529,6 +2543,10 @@ 0.9D0 0.9D0 + +Zender_2003 +atm + 1.35D0 @@ -2971,12 +2989,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 @@ -3344,6 +3491,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 + ', @@ -3455,6 +3610,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 350d55a64c..b1167e987b 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -1332,6 +1332,12 @@ Whether or not to enable gravity waves produced by shallow convection. Default: .false. + +Whether or not to enable gravity waves from PBL moving mountains source. +Default: .false. + + Gravity wave spectrum dimension (wave numbers are from -pgwv to pgwv). @@ -1533,6 +1539,13 @@ Width of gaussian used to create frontogenesis tau profile [m/s]. Default: set by build-namelist. + +Tunable parameter controlling proportion of boundary layer momentum flux escaping as GW momentum flux +Default: set by build-namelist. + + + Full pathname of Beres lookup table data file for gravity waves sourced @@ -1547,6 +1560,12 @@ from shallow convection. Default: set by build-namelist. + +Relative pathname of lookup table for deep convective moving mountain GW source +Default: set by build-namelist. + + Background source strength (used for waves from frontogenesis). @@ -5983,6 +6002,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 @@ -7679,6 +7704,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 + + - - - - - - - - -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/aquaplanet_cam5.xml b/bld/namelist_files/use_cases/aquaplanet_cam5.xml index 814eecd98f..f5a3ed7988 100644 --- a/bld/namelist_files/use_cases/aquaplanet_cam5.xml +++ b/bld/namelist_files/use_cases/aquaplanet_cam5.xml @@ -18,9 +18,7 @@ 348.0e-6 -atm/cam/solar/ape_solar_ave_tsi_1365.nc -.true. -/ +atm/cam/solar/ape_solar_ave_tsi_1365.nc apeozone_cam3_5_54.nc diff --git a/bld/namelist_files/use_cases/aquaplanet_cam6.xml b/bld/namelist_files/use_cases/aquaplanet_cam6.xml index 814eecd98f..f5a3ed7988 100644 --- a/bld/namelist_files/use_cases/aquaplanet_cam6.xml +++ b/bld/namelist_files/use_cases/aquaplanet_cam6.xml @@ -18,9 +18,7 @@ 348.0e-6 -atm/cam/solar/ape_solar_ave_tsi_1365.nc -.true. -/ +atm/cam/solar/ape_solar_ave_tsi_1365.nc apeozone_cam3_5_54.nc diff --git a/bld/namelist_files/use_cases/aquaplanet_rce_cam6.xml b/bld/namelist_files/use_cases/aquaplanet_rce_cam6.xml index f03c4294b2..7b93fa8418 100644 --- a/bld/namelist_files/use_cases/aquaplanet_rce_cam6.xml +++ b/bld/namelist_files/use_cases/aquaplanet_rce_cam6.xml @@ -1,8 +1,9 @@ - - + + atm/cam/inic/se/initial_data.cam.ne30.L32.RCEMIP_c20190507.nc + 0. 0. @@ -12,18 +13,6 @@ false - atm/cam/ozone/ - ozone.cam.ne30.L32.RCEMIP_c20190507.nc - atm/cam/inic/se/initial_data.cam.ne30.L32.RCEMIP_c20190507.nc - atm/cam/solar/solar_tsi_551_with_ssi.cam.ne30.L32.RCEMIP_c20190507.nc - .false. - - true - I - 1 - 1 - 'T','Q','U','V','PS','PRECT','Z3' - 1.650e-6 0.306e-6 @@ -32,13 +21,12 @@ 0.0 0.0 - -atm/cam/solar/ape_solar_ave_tsi_1365.nc -.true. -/ + + atm/cam/solar/solar_tsi_551_with_ssi.cam.ne30.L32.RCEMIP_c20190507.nc + .false. - -apeozone_cam3_5_54.nc + + ozone.cam.ne30.L32.RCEMIP_c20190507.nc atm/cam/ozone OZONE CYCLICAL @@ -48,7 +36,6 @@ .true. 0.73391095 - 0.0 86164.10063718943 @@ -67,4 +54,10 @@ "" 0.0 + true + I + 1 + 1 + 'T','Q','U','V','PS','PRECT','Z3' + diff --git a/bld/namelist_files/use_cases/hist_trop_strat_ts4_cam7.xml b/bld/namelist_files/use_cases/hist_trop_strat_ts4_cam7.xml new file mode 100644 index 0000000000..4e65f4f34c --- /dev/null +++ b/bld/namelist_files/use_cases/hist_trop_strat_ts4_cam7.xml @@ -0,0 +1,32 @@ + + + + + +atm/cam/inic/se/f.cam6_3_153.FCMTnudged_climate_chemistry_ne30.factor_fix.cam.i.1996-01-01-00000_c220522.nc + + +atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc +SERIAL + + +SERIAL + +INTERP_MISSING_MONTHS + +INTERP_MISSING_MONTHS + + +SERIAL +atm/waccm/lb/LBC_17500116-25001216_CMIP6_SSP585_0p5degLat_c20200824.nc + + 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', + 'HCFC22', 'N2O', 'CFC114', 'CFC115', 'HCFC141B', 'HCFC142B', 'H2402', 'OCS', 'SF6', 'CFC11eq' + + + +.true. +.false. +.false. + + diff --git a/bld/namelist_files/use_cases/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/waccm_sc_2000_cam6.xml b/bld/namelist_files/use_cases/waccm_sc_2000_cam6.xml index cdb217a987..040cf5acfc 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 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..a77688d0f1 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 diff --git a/bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml b/bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml index 5658d9cb1d..d40cc385f4 100644 --- a/bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml +++ b/bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml @@ -112,7 +112,6 @@ 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jhocl', 'jno3_b', 'jcl2o2', 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE','AOA1','AOA2', 'O2', 'CLDLIQ', 'CLDICE', 'ASDIR', - 'VTHzm', 'WTHzm', 'UVzm', 'UWzm', 'TH', 'MSKtem', 'O2_1S', 'O2_1D', 'Op', 'O2p', 'Np', 'NOp', 'N2p', 'e', 'UIONTEND', 'VIONTEND', 'UTGWSPEC', 'UTGWORO', 'VTGWSPEC', 'VTGWORO', 'TTGW', diff --git a/bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml b/bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml index c928b43f28..cc6eea7802 100644 --- a/bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml +++ b/bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml @@ -93,7 +93,7 @@ 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN' - + 'MSKtem', 'PS', 'PSL', 'VTHzm', 'UVzm', 'UWzm', 'Uzm', 'Vzm', 'THzm','Wzm', 'PHIS' diff --git a/cime_config/SystemTests/sct.py b/cime_config/SystemTests/sct.py index 23108fc3a5..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]) 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 b8cc333601..0328e84f2f 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -52,7 +52,7 @@ def _build_fms(caseroot, libroot, bldroot): mpilib = case.get_value("MPILIB") sharedpath = os.path.join(case.get_value("COMPILER"), mpilib, - strdebug, strthread, "nuopc") + strdebug, strthread) slr = os.path.abspath(case.get_value("SHAREDLIBROOT")) fmsbuildroot = os.path.join(slr, sharedpath) fmsinstallpath = os.path.join(fmsbuildroot, "FMS") @@ -108,7 +108,7 @@ 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, "FMS") + 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"), diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 560bca7ef2..6d652e8e03 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -8,10 +8,10 @@ CAM =============== --> - CAM cam7 physics: - CAM cam6 physics: - CAM cam5 physics: - CAM cam4 physics: + CAM cam7 physics: + CAM cam6 physics: + CAM cam5 physics: + CAM cam4 physics: CAM cam3 physics: CAM simplified and non-versioned physics : @@ -28,7 +28,7 @@ SINGLE COLUMN CAM =============== --> - 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: @@ -142,8 +143,8 @@ -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 @@ -176,6 +177,24 @@ -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 -phys adiabatic @@ -263,6 +282,7 @@ 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 @@ -301,9 +321,6 @@ dctest_tj2016 dctest_frierson dctest_baro_kessler - - - run_component_cam env_run.xml @@ -360,7 +377,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 3a4bb4bad4..64efaabe08 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -63,22 +63,22 @@ FLTHIST - HIST_CAM70%LT_CLM51%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + HIST_CAM70%LT_CLM60%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV FMTHIST - HIST_CAM70%MT_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_CAM70%LT_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_CAM70%MT_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 @@ -213,7 +303,7 @@ QPSCAMC5 - 2000_CAM50%SCAM_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV + 2000_CAM50%SCAMARM97_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV @@ -282,7 +372,7 @@ F2000dev - 2000_CAM70_CLM51%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + 2000_CAM70_CLM60%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV @@ -344,11 +434,15 @@ FCLTHIST - HIST_CAM70%LT%CCTS1_CLM51%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + HIST_CAM70%LT%CCTS1_CLM60%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV FCMTHIST - HIST_CAM70%MT%CCTS1_CLM51%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 +674,6 @@ - 1997-06-18 1979-01-01 1950-01-01 2000-01-01 @@ -602,12 +695,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 +864,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 c074a75baf..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 + + + + @@ -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 f1a0d0799d..2865df7aae 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -1159,16 +1159,28 @@ + + + + + + + + + + + + @@ -1188,6 +1200,7 @@ + @@ -1349,10 +1362,21 @@ + + + + + + + + + + + @@ -1456,21 +1480,23 @@ - + + - + + @@ -1480,6 +1506,24 @@ + + + + + + + + + + + + + + + + + + @@ -1542,51 +1586,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -1916,6 +1915,24 @@ + + + + + + + + + + + + + + + + + + @@ -2006,7 +2023,7 @@ - + @@ -2246,7 +2263,7 @@ - + @@ -2265,6 +2282,25 @@ + + + + + + + + + + + + + + + + + + + @@ -2435,7 +2471,16 @@ - + + + + + + + + + + @@ -2452,6 +2497,7 @@ + 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_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_nondefault/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_nondefault/user_nl_clm deleted file mode 100644 index 12d5a36d2b..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_nondefault/user_nl_clm +++ /dev/null @@ -1,26 +0,0 @@ -!---------------------------------------------------------------------------------- -! Users should add all user specific namelist changes below in the form of -! namelist_var = new_namelist_value -! -! Include namelist variables for drv_flds_in ONLY if -megan and/or -drydep options -! are set in the CLM_NAMELIST_OPTS env variable. -! -! EXCEPTIONS: -! Set use_cndv by the compset you use and the CLM_BLDNML_OPTS -dynamic_vegetation setting -! Set use_vichydro by the compset you use and the CLM_BLDNML_OPTS -vichydro setting -! Set use_cn by the compset you use and CLM_BLDNML_OPTS -bgc setting -! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting -! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup setting -! Set irrigate by the CLM_BLDNML_OPTS -irrig setting -! Set dtime with L_NCPL option -! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options -! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases -! (includes $inst_string for multi-ensemble cases) -! Set glc_grid with CISM_GRID option -! Set glc_smb with GLC_SMB option -! Set maxpatch_glcmec with GLC_NEC option -! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable -!---------------------------------------------------------------------------------- -hist_nhtfrq = 9 -hist_mfilt = 1 -hist_ndens = 1 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/user_nl_cam deleted file mode 100644 index 8482082dce..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/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/outfrq9s_mg3_pcols1536/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/user_nl_clm deleted file mode 100644 index 12d5a36d2b..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/user_nl_clm +++ /dev/null @@ -1,26 +0,0 @@ -!---------------------------------------------------------------------------------- -! Users should add all user specific namelist changes below in the form of -! namelist_var = new_namelist_value -! -! Include namelist variables for drv_flds_in ONLY if -megan and/or -drydep options -! are set in the CLM_NAMELIST_OPTS env variable. -! -! EXCEPTIONS: -! Set use_cndv by the compset you use and the CLM_BLDNML_OPTS -dynamic_vegetation setting -! Set use_vichydro by the compset you use and the CLM_BLDNML_OPTS -vichydro setting -! Set use_cn by the compset you use and CLM_BLDNML_OPTS -bgc setting -! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting -! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup setting -! Set irrigate by the CLM_BLDNML_OPTS -irrig setting -! Set dtime with L_NCPL option -! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options -! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases -! (includes $inst_string for multi-ensemble cases) -! Set glc_grid with CISM_GRID option -! Set glc_smb with GLC_SMB option -! Set maxpatch_glcmec with GLC_NEC option -! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable -!---------------------------------------------------------------------------------- -hist_nhtfrq = 9 -hist_mfilt = 1 -hist_ndens = 1 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760/shell_commands similarity index 70% rename from cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/shell_commands rename to cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760/shell_commands index d6e6750eb4..f9424e5025 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760/shell_commands @@ -1,8 +1,8 @@ -./xmlchange NTASKS=36 +./xmlchange NTASKS=64 ./xmlchange NTHRDS=1 ./xmlchange ROOTPE='0' ./xmlchange ROF_NCPL=`./xmlquery --value ATM_NCPL` ./xmlchange GLC_NCPL=`./xmlquery --value ATM_NCPL` -./xmlchange CAM_CONFIG_OPTS=' -microphys mg3 -pcols 1536' --append +./xmlchange CAM_CONFIG_OPTS=' -microphys mg3 -pcols 760 ' --append ./xmlchange TIMER_DETAIL='6' ./xmlchange TIMER_LEVEL='999' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg2_default/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760/user_nl_cam similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg2_default/user_nl_cam rename to cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760/user_nl_cam diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg2_default/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760/user_nl_clm similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg2_default/user_nl_clm rename to cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760/user_nl_clm diff --git a/cime_config/testdefs/testmods_dirs/cam/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/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_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/cism b/components/cism index c05dd5c4fc..c84cc9f5b3 160000 --- a/components/cism +++ b/components/cism @@ -1 +1 @@ -Subproject commit c05dd5c4fc85327e76523aaea9cfe1e388748928 +Subproject commit c84cc9f5b3103766a35d0a7ddd5e9dbd7deae762 diff --git a/doc/ChangeLog b/doc/ChangeLog index 1ea6b30039..391de001e2 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,61 +1,2683 @@ =============================================================== -Tag name: +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: -One-line Summary: Use same cloud water for radiation and COSP. -Github PR URL: +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 -Issue #1027 - Radiatively active cloud water missing from COSP. +Describe any changes made to build system: N/A -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. +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. -resolves #1027 +List any changes to the defaults for the boundary datasets: N/A -Describe any changes made to build system: none +Describe any substantial timing or memory changes: N/A -Describe any changes made to the namelist: none +Code reviewed by: cacraig, nusbaume -List any changes to the defaults for the boundary datasets: none +List all files eliminated: -Describe any substantial timing or memory changes: none +List all files added and what they do: +A src/physics/cam/gw_movmtn.F90 + - Moving mountain module -Code reviewed by: +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 -List all files eliminated: none +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 -List all files added and what they do: none +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 -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 +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. -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 +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 -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. + 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 -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, @@ -64,17 +2686,170 @@ 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: BFB. Only COSP diagnostic fields have -differences. +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 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/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/modal_aero/aero_model.F90 b/src/chemistry/modal_aero/aero_model.F90 index 43ef5caa33..86236a0650 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('ma_convproc') + call ma_convproc_intr( state, ptend, pbuf, dt, & + nsrflx_mzaer2cnvpr, qsrflx_mzaer2cnvpr, aerdepwetis, dcondt_resusp3d) + + if (convproc_do_evaprain_atonce) then + do m = 1, ntot_amode ! main loop over aerosol modes + + do lspec = 0, nspec_amode(m) ! loop over number + chem constituents + if (lspec == 0) then ! number + mm = numptrcw_amode(m) + else if (lspec <= nspec_amode(m)) then ! non-water mass + mm = lmassptrcw_amode(lspec,m) + endif + fldcw => qqcw_get_field(pbuf, mm,lchnk) + + call outfld( trim(cnst_name_cw(mm))//'RSPTD', dcondt_resusp3d(mm+pcnst,:ncol,:), ncol, lchnk ) + + do k = 1,pver + do i = 1,ncol + fldcw(i,k) = max(0._r8, fldcw(i,k) + dcondt_resusp3d(mm+pcnst,i,k)*dt) + end do + end do + end do ! loop over number + chem constituents + end do ! m aerosol modes + end if + call t_stopf('ma_convproc') + endif + do m = 1, ntot_amode ! main loop over aerosol modes do lphase = strt_loop,end_loop, stride_loop ! loop over interstitial (1) and cloud-borne (2) forms @@ -1289,7 +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 @@ -1326,7 +1351,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 +1366,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 +1392,7 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) enddo enddo call outfld( trim(cnst_name(mm))//'SFSBC', sflx, pcols, lchnk) - if (convproc_do_aer)sflxbc = sflx + if (convproc_do_aer) sflxbc = sflx sflx(:)=0._r8 do k=1,pver @@ -1611,46 +1636,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/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_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/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/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 a0b35e5a1d..99fb9b3a0b 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) diff --git a/src/control/cam_snapshot_common.F90 b/src/control/cam_snapshot_common.F90 index a4ac1b2009..a1a8419619 100644 --- a/src/control/cam_snapshot_common.F90 +++ b/src/control/cam_snapshot_common.F90 @@ -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 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/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 c96a01eca4..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 @@ -1118,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/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 beba3d3611..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,7 +306,7 @@ 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 @@ -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) diff --git a/src/dynamics/se/dycore/global_norms_mod.F90 b/src/dynamics/se/dycore/global_norms_mod.F90 index 5290017c8e..e4701c9d37 100644 --- a/src/dynamics/se/dycore/global_norms_mod.F90 +++ b/src/dynamics/se/dycore/global_norms_mod.F90 @@ -639,7 +639,11 @@ 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_090_140km.or.top_140_600km) then ! defaults for waccm(x) + 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 diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index b9b6b746e0..018c281253 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -444,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 @@ -508,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 @@ -668,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_driver_mod.F90 b/src/dynamics/se/dycore/prim_driver_mod.F90 index dc012e2d12..e2d470f616 100644 --- a/src/dynamics/se/dycore/prim_driver_mod.F90 +++ b/src/dynamics/se/dycore/prim_driver_mod.F90 @@ -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 ! @@ -238,7 +238,8 @@ 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 @@ -265,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 @@ -306,11 +307,17 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') end if call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBL') - call prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r,nsubstep==nsplit,dt_remap) + 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) @@ -320,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 @@ -339,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: @@ -441,8 +448,8 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep, last_s 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(:) @@ -575,7 +582,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep, last_s ! ! 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) @@ -612,7 +619,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep, last_s ! 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 @@ -623,8 +630,81 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep, last_s 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 !=======================================================================================================! @@ -729,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/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/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 5dcffe7347..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 @@ -747,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 @@ -990,6 +998,8 @@ subroutine dyn_run(dyn_state) 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 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 @@ -1008,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 @@ -1019,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)) @@ -1125,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 @@ -1150,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) @@ -1353,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' @@ -1874,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 (.not.use_cslam) 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 @@ -1891,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 diff --git a/src/dynamics/se/dyn_grid.F90 b/src/dynamics/se/dyn_grid.F90 index aa3ec8027a..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. @@ -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 a19733b465..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 @@ -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/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 5f719ce0c2..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 @@ -395,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(:,:) @@ -430,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 ) @@ -467,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 @@ -480,8 +480,6 @@ 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 ! - pull some fields from pbuf and dyn_in @@ -847,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) 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/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90 index 9c16325357..2886c44222 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 @@ -942,9 +942,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 ) @@ -1035,9 +1033,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 ) @@ -1699,9 +1695,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. @@ -1799,11 +1793,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 ! @@ -2060,7 +2056,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/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 2f7d0215cf..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,7 +32,7 @@ module cloud_diagnostics logical :: do_cld_diag, mg_clouds, rk_clouds, camrt_rad, spcam_m2005_clouds, spcam_sam1mom_clouds logical :: one_mom_clouds, two_mom_clouds - + integer :: cicewp_idx = -1 integer :: cliqwp_idx = -1 integer :: cldemis_idx = -1 @@ -84,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 @@ -111,13 +114,19 @@ subroutine cloud_diagnostics_init() if (two_mom_clouds) then + ! initialize to zero + if (is_first_step()) then + call pbuf_set_field(pbuf2d, iciwp_idx, 0._r8) + call pbuf_set_field(pbuf2d, iclwp_idx, 0._r8) + end if + call addfld ('ICWMR', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-cloud water mixing ratio') call addfld ('ICIMR', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-cloud ice mixing ratio' ) call addfld ('IWC', (/ 'lev' /), 'A', 'kg/m3', 'Grid box average ice water content' ) call addfld ('LWC', (/ 'lev' /), 'A', 'kg/m3', 'Grid box average liquid water content' ) ! determine the add_default fields - call phys_getopts(history_amwg_out = history_amwg) + call phys_getopts(history_amwg_out = history_amwg) if (history_amwg) then call add_default ('ICWMR', 1, ' ') @@ -142,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 @@ -163,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') @@ -214,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 @@ -286,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 @@ -428,7 +437,7 @@ subroutine cloud_diagnostics_calc(state, pbuf) allcld_liq = state%q(:,:,ixcldliq) allcld_ice = state%q(:,:,ixcldice) end if - + do k=1,pver do i = 1,ncol gicewp(i,k) = allcld_ice(i,k)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. @@ -449,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 @@ -466,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) @@ -494,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) @@ -518,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 89bbaf4294..061e24fdcd 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -31,27 +31,33 @@ module clubb_intr #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, stats_metadata_type + 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 - + type (hm_metadata_type) :: & + hm_metadata + type (stats_metadata_type) :: & stats_metadata - + type (sclr_idx_type) :: & + sclr_idx #endif private @@ -84,32 +90,52 @@ module clubb_intr #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 @@ -186,7 +212,7 @@ module clubb_intr 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 ! (double Gaussian) PDF type to use for the w, rt, @@ -195,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 :: & @@ -315,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)) @@ -403,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, & @@ -477,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 @@ -487,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 '/) @@ -574,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) @@ -844,7 +893,7 @@ subroutine clubb_readnl(nlfile) !----- Begin Code ----- - ! Determine if we want clubb_history to be output + ! Determine if we want clubb_history to be output clubb_history = .false. ! Initialize to false stats_metadata%l_stats = .false. ! Initialize to false stats_metadata%l_output_rad_files = .false. ! Initialize to false @@ -856,6 +905,7 @@ subroutine clubb_readnl(nlfile) 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 @@ -909,7 +959,8 @@ subroutine clubb_readnl(nlfile) 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) @@ -1158,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) @@ -1201,7 +1256,7 @@ subroutine clubb_readnl(nlfile) ! Overwrite defaults if they are true if (clubb_history) stats_metadata%l_stats = .true. - if (clubb_rad_history) stats_metadata%l_output_rad_files = .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. @@ -1267,6 +1322,7 @@ subroutine clubb_readnl(nlfile) 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") @@ -1274,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 @@ -1328,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 @@ -1373,7 +1431,8 @@ subroutine clubb_ini_cam(pbuf2d) 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, & @@ -1384,19 +1443,13 @@ subroutine clubb_ini_cam(pbuf2d) read_parameters_api, & 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 @@ -1529,7 +1582,7 @@ subroutine clubb_ini_cam(pbuf2d) stats_metadata%l_stats_samp = .false. stats_metadata%l_grads = .false. - ! Overwrite defaults if needbe + ! Overwrite defaults if needed if (stats_metadata%l_stats) stats_metadata%l_stats_samp = .true. ! Define physics buffers indexes @@ -1552,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 @@ -1600,7 +1653,7 @@ subroutine clubb_ini_cam(pbuf2d) 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, & @@ -1625,75 +1678,81 @@ subroutine clubb_ini_cam(pbuf2d) C_invrs_tau_wpxp_Ri, C_invrs_tau_wpxp_N2_thresh, & Cx_min, Cx_max, Richardson_num_min, Richardson_num_max, & wpxp_Ri_exp, a3_coef_min, a_const, bv_efold, z_displace, & - 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 - clubb_params(ibv_efold) = clubb_bv_efold - clubb_params(iwpxp_Ri_exp) = clubb_wpxp_Ri_exp - clubb_params(iz_displace) = clubb_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, & ! 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') @@ -1703,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 @@ -1810,18 +1869,27 @@ 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 (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(:)) + + 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' ) @@ -1984,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 @@ -2033,7 +2114,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & #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, & @@ -2046,7 +2126,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rt_tol, & thl_tol, & 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, & @@ -2255,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 @@ -2421,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 @@ -2489,12 +2583,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & character(len=*), parameter :: subr='clubb_tend_cam' real(r8), parameter :: rad2deg=180.0_r8/pi real(r8) :: tmp_lon1, tmp_lonN - + type(grid) :: gr - + 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 @@ -2644,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) ) @@ -2667,16 +2778,8 @@ 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) if (clubb_do_icesuper) then @@ -2975,7 +3078,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 @@ -3034,10 +3137,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & 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. - + + ! Heights need to be set at each timestep. Therefore, recall + ! setup_grid and setup_parameters for this. + ! Set-up CLUBB core at each CLUBB call because heights can change ! Important note: do not make any calls that use CLUBB grid-height ! operators (such as zt2zm_api, etc.) until AFTER the @@ -3047,6 +3150,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & zi_g, zt_g, & ! intent(in) gr ) ! intent(out) + do i = 1, ncol + clubb_params(i,:) = clubb_params_single_col(:) + end do + call setup_parameters_api( zi_g(:,2), clubb_params, gr, ncol, grid_type, & ! intent(in) clubb_config_flags%l_prescribed_avg_deltaz, & ! intent(in) lmin, nu_vert_res_dep, err_code ) ! intent(out) @@ -3332,9 +3439,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif + ! need to initialize macmic coupling to zero + if (macmic_it==1) ttend_clubb_mc(:ncol,:) = 0._r8 + if (macmic_it==1) upwp_clubb_gw_mc(:ncol,:) = 0._r8 + if (macmic_it==1) vpwp_clubb_gw_mc(:ncol,:) = 0._r8 + if (macmic_it==1) thlp2_clubb_gw_mc(:ncol,:) = 0._r8 + if (macmic_it==1) wpthlp_clubb_gw_mc(:ncol,:) = 0._r8 do t=1,nadv ! do needed number of "sub" timesteps for each CAM step - + ! Increment the statistics then begin stats timestep if (stats_metadata%l_stats) then call stats_begin_timestep_api( t, stats_nsamp, stats_nout, & @@ -3366,18 +3479,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 @@ -3400,7 +3513,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Advance CLUBB CORE one timestep in the future call advance_clubb_core_api( gr, pverp+1-top_lev, ncol, & - l_implemented, dtime, fcor, sfc_elevation, hydromet_dim, & + l_implemented, dtime, fcor, sfc_elevation, & + hydromet_dim, & + sclr_dim, sclr_tol, edsclr_dim, sclr_idx, & thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & sclrm_forcing, edsclrm_forcing, wprtp_forcing, & wpthlp_forcing, rtp2_forcing, thlp2_forcing, & @@ -3411,7 +3526,8 @@ 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, & @@ -3492,7 +3608,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & thlp2_rad_out(:,:) = 0._r8 do i=1, ncol - call calculate_thlp2_rad_api(nlev+1, rcm_out_zm(i,:), thlprcp_out(i,:), qrl_zm(i,:), clubb_params, & + call calculate_thlp2_rad_api(nlev+1, rcm_out_zm(i,:), thlprcp_out(i,:), qrl_zm(i,:), clubb_params(i,:), & thlp2_rad_out(i,:)) end do @@ -3604,6 +3720,20 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do + ! Accumulate vars through macmic subcycle + upwp_clubb_gw_mc(:ncol,:) = upwp_clubb_gw_mc(:ncol,:) + upwp(:ncol,:) + vpwp_clubb_gw_mc(:ncol,:) = vpwp_clubb_gw_mc(:ncol,:) + vpwp(:ncol,:) + thlp2_clubb_gw_mc(:ncol,:) = thlp2_clubb_gw_mc(:ncol,:) + thlp2(:ncol,:) + wpthlp_clubb_gw_mc(:ncol,:) = wpthlp_clubb_gw_mc(:ncol,:) + wpthlp(:ncol,:) + + ! And average at last macmic step + if (macmic_it == cld_macmic_num_steps) then + upwp_clubb_gw(:ncol,:) = upwp_clubb_gw_mc(:ncol,:)/REAL(cld_macmic_num_steps,r8) + vpwp_clubb_gw(:ncol,:) = vpwp_clubb_gw_mc(:ncol,:)/REAL(cld_macmic_num_steps,r8) + thlp2_clubb_gw(:ncol,:) = thlp2_clubb_gw_mc(:ncol,:)/REAL(cld_macmic_num_steps,r8) + wpthlp_clubb_gw(:ncol,:) = wpthlp_clubb_gw_mc(:ncol,:)/REAL(cld_macmic_num_steps,r8) + end if + do k=1, nlev+1 do i=1, ncol @@ -3793,23 +3923,31 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & 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 - 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) + 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 + 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 - rtm_integral_ltend(:) = rtm_integral_ltend(:)/gravit - rtm_integral_vtend(:) = rtm_integral_vtend(:)/gravit - if (clubb_do_adv) then if (macmic_it == cld_macmic_num_steps) then @@ -4181,7 +4319,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. & @@ -4371,8 +4509,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if ! Output CLUBB history here - if (stats_metadata%l_stats) then - + if (stats_metadata%l_stats) then + do j=1,stats_zt(1)%num_output_fields temp1 = trim(stats_zt(1)%file%grid_avg_var(j)%name) @@ -4391,7 +4529,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld(trim(sub),out_zm(:,:,j), pcols, lchnk) enddo - if (stats_metadata%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 @@ -4692,7 +4830,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & ! Set stats_variables variables with inputs from calling subroutine stats_metadata%l_stats = l_stats_in - + stats_metadata%stats_tsamp = stats_tsamp_in stats_metadata%stats_tout = stats_tout_in @@ -4759,8 +4897,8 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & ! 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. & + 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 @@ -4796,15 +4934,17 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & 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( clubb_vars_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. & + 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 @@ -4833,17 +4973,19 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & 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( clubb_vars_zm, & + 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. & + 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 @@ -4877,10 +5019,10 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & 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. & + 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 @@ -4909,7 +5051,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & 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) ) @@ -4917,10 +5059,9 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & ! 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. & + 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 @@ -4962,30 +5103,30 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & endif ! Now call add fields - + do i = 1, stats_zt(1)%num_output_fields - + 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(1)%file%grid_avg_var(i)%units), & trim(stats_zt(1)%file%grid_avg_var(i)%description) ) enddo - + do i = 1, stats_zm(1)%num_output_fields - + 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(1)%file%grid_avg_var(i)%units), & trim(stats_zm(1)%file%grid_avg_var(i)%description) ) enddo - if (stats_metadata%l_output_rad_files) then + if (stats_metadata%l_output_rad_files) then do i = 1, stats_rad_zt(1)%num_output_fields temp1 = trim(stats_rad_zt(1)%file%grid_avg_var(i)%name) @@ -4995,7 +5136,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & 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(1)%num_output_fields temp1 = trim(stats_rad_zm(1)%file%grid_avg_var(i)%name) sub = temp1 @@ -5005,7 +5146,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & trim(stats_rad_zm(1)%file%grid_avg_var(i)%description) ) enddo endif - + do i = 1, stats_sfc(1)%num_output_fields temp1 = trim(stats_sfc(1)%file%grid_avg_var(i)%name) sub = temp1 @@ -5014,7 +5155,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & trim(stats_sfc(1)%file%grid_avg_var(i)%units), & trim(stats_sfc(1)%file%grid_avg_var(i)%description) ) enddo - + return @@ -5103,7 +5244,7 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st enddo enddo - if (stats_metadata%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) diff --git a/src/physics/cam/convect_shallow.F90 b/src/physics/cam/convect_shallow.F90 index ffd1db8f5f..daed093b67 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' ) 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/gw_drag.F90 b/src/physics/cam/gw_drag.F90 index f8eca5dd1f..aeab27a5c6 100644 --- a/src/physics/cam/gw_drag.F90 +++ b/src/physics/cam/gw_drag.F90 @@ -28,6 +28,8 @@ module gw_drag use cam_history, only: outfld use cam_logfile, only: iulog use cam_abortutils, only: endrun + use error_messages, only: alloc_err + use ref_pres, only: do_molec_diff, nbot_molec, press_lim_idx use physconst, only: cpair @@ -35,10 +37,11 @@ module gw_drag ! These are the actual switches for different gravity wave sources. use phys_control, only: use_gw_oro, use_gw_front, use_gw_front_igw, & use_gw_convect_dp, use_gw_convect_sh, & - use_simple_phys + use_simple_phys, use_gw_movmtn_pbl use gw_common, only: GWBand use gw_convect, only: BeresSourceDesc + use gw_movmtn, only: MovMtnSourceDesc use gw_front, only: CMSourceDesc ! Typical module header @@ -64,6 +67,8 @@ module gw_drag type(GWBand) :: band_mid ! Long scale waves for IGWs. type(GWBand) :: band_long + ! Medium scale waves for moving mountain + type(GWBand) :: band_movmtn ! Top level for gravity waves. integer, parameter :: ktop = 1 @@ -129,13 +134,17 @@ module gw_drag logical :: gw_apply_tndmax = .true. ! Files to read Beres source spectra from. - character(len=256) :: gw_drag_file = "" - character(len=256) :: gw_drag_file_sh = "" + character(len=cl) :: gw_drag_file = "" + character(len=cl) :: gw_drag_file_sh = "" + character(len=cl) :: gw_drag_file_mm = "" ! Beres settings and table. type(BeresSourceDesc) :: beres_dp_desc type(BeresSourceDesc) :: beres_sh_desc + ! Moving mountain settings and table. + type(MovMtnSourceDesc) :: movmtn_desc + ! Frontogenesis wave settings. type(CMSourceDesc) :: cm_desc type(CMSourceDesc) :: cm_igw_desc @@ -148,6 +157,13 @@ module gw_drag integer :: frontga_idx = -1 integer :: sgh_idx = -1 + ! From CLUBB + integer :: ttend_clubb_idx = -1 + integer :: upwp_clubb_gw_idx = -1 + integer :: vpwp_clubb_gw_idx = -1 + integer :: thlp2_clubb_gw_idx = -1 + integer :: wpthlp_clubb_gw_idx = -1 + ! anisotropic ridge fields integer, parameter :: prdg = 16 @@ -186,9 +202,11 @@ module gw_drag real(r8) :: gw_prndl = 0.25_r8 real(r8) :: gw_qbo_hdepth_scaling = 1._r8 ! heating depth scaling factor - ! Width of gaussian used to create frontogenesis tau profile [m/s]. + ! Width of gaussian used to create frontogenesis tau profile [m s-1]. real(r8) :: front_gaussian_width = -huge(1._r8) + real(r8) :: alpha_gw_movmtn + logical :: gw_top_taper=.false. real(r8), pointer :: vramp(:)=>null() @@ -224,7 +242,7 @@ subroutine gw_drag_readnl(nlfile) namelist /gw_drag_nl/ pgwv, gw_dc, pgwv_long, gw_dc_long, tau_0_ubc, & effgw_beres_dp, effgw_beres_sh, effgw_cm, effgw_cm_igw, effgw_oro, & - fcrit2, frontgfc, gw_drag_file, gw_drag_file_sh, taubgnd, & + fcrit2, frontgfc, gw_drag_file, gw_drag_file_sh, gw_drag_file_mm, taubgnd, & taubgnd_igw, gw_polar_taper, & use_gw_rdg_beta, n_rdg_beta, effgw_rdg_beta, effgw_rdg_beta_max, & rdg_beta_cd_llb, trpd_leewv_rdg_beta, & @@ -232,7 +250,7 @@ subroutine gw_drag_readnl(nlfile) rdg_gamma_cd_llb, trpd_leewv_rdg_gamma, bnd_rdggm, & gw_oro_south_fac, gw_limit_tau_without_eff, & gw_lndscl_sgh, gw_prndl, gw_apply_tndmax, gw_qbo_hdepth_scaling, & - gw_top_taper, front_gaussian_width + gw_top_taper, front_gaussian_width, alpha_gw_movmtn !---------------------------------------------------------------------- if (use_simple_phys) return @@ -332,10 +350,15 @@ subroutine gw_drag_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: gw_drag_file") call mpi_bcast(gw_drag_file_sh, len(gw_drag_file_sh), mpi_character, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: gw_drag_file_sh") + call mpi_bcast(gw_drag_file_mm, len(gw_drag_file_mm), mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: gw_drag_file_mm") call mpi_bcast(front_gaussian_width, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: front_gaussian_width") + call mpi_bcast(alpha_gw_movmtn, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: alpha_gw_movmtn") + ! Check if fcrit2 was set. call shr_assert(fcrit2 /= unset_r8, & "gw_drag_readnl: fcrit2 must be set via the namelist."// & @@ -355,6 +378,7 @@ subroutine gw_drag_readnl(nlfile) band_oro = GWBand(0, gw_dc, fcrit2, wavelength_mid) band_mid = GWBand(pgwv, gw_dc, 1.0_r8, wavelength_mid) band_long = GWBand(pgwv_long, gw_dc_long, 1.0_r8, wavelength_long) + band_movmtn = GWBand(0, gw_dc, 1.0_r8, wavelength_mid) if (use_gw_rdg_gamma .or. use_gw_rdg_beta) then call gw_rdg_readnl(nlfile) @@ -468,14 +492,14 @@ subroutine gw_init() integer :: grid_id character(len=8) :: dim1name, dim2name logical :: found - character(len=256) :: bnd_rdggm_loc ! filepath of topo file on local disk + character(len=cl) :: bnd_rdggm_loc ! filepath of topo file on local disk ! Allow reporting of error messages. character(len=128) :: errstring character(len=*), parameter :: sub = 'gw_init' ! temporary workaround for restart w/ ridge scheme - character(len=256) :: bnd_topo_loc ! filepath of topo file on local disk + character(len=cl) :: bnd_topo_loc ! filepath of topo file on local disk integer :: botndx,topndx @@ -506,7 +530,7 @@ subroutine gw_init() end if ! pre-calculated newtonian damping: - ! * convert to 1/s + ! * convert to s-1 ! * ensure it is not smaller than 1e-6 ! * convert palph from hpa to pa @@ -549,7 +573,7 @@ subroutine gw_init() if ( use_gw_oro ) then if (effgw_oro == unset_r8) then - call endrun("gw_drag_init: Orographic gravity waves enabled, & + call endrun("gw_init: Orographic gravity waves enabled, & &but effgw_oro was not set.") end if end if @@ -559,22 +583,22 @@ subroutine gw_init() sgh_idx = pbuf_get_index('SGH') ! Declare history variables for orographic term - call addfld ('TAUAORO', (/ 'ilev' /), 'I','N/m2', & + call addfld ('TAUAORO', (/ 'ilev' /), 'I','N m-2', & 'Total stress from original OGW scheme') - call addfld ('TTGWORO', (/ 'lev' /), 'A','K/s', & + call addfld ('TTGWORO', (/ 'lev' /), 'A','K s-1', & 'T tendency - orographic gravity wave drag') - call addfld ('TTGWSDFORO', (/ 'lev' /), 'A','K/s', & + call addfld ('TTGWSDFORO', (/ 'lev' /), 'A','K s-1', & 'T tendency - orographic gravity wave, diffusion.') - call addfld ('TTGWSKEORO', (/ 'lev' /), 'A','K/s', & + call addfld ('TTGWSKEORO', (/ 'lev' /), 'A','K s-1', & 'T tendency - orographic gravity wave, breaking KE.') - call addfld ('UTGWORO', (/ 'lev' /), 'A','m/s2', & + call addfld ('UTGWORO', (/ 'lev' /), 'A','m s-2', & 'U tendency - orographic gravity wave drag') - call addfld ('VTGWORO', (/ 'lev' /), 'A','m/s2', & + call addfld ('VTGWORO', (/ 'lev' /), 'A','m s-2', & 'V tendency - orographic gravity wave drag') call register_vector_field('UTGWORO', 'VTGWORO') - call addfld ('TAUGWX', horiz_only, 'A','N/m2', & + call addfld ('TAUGWX', horiz_only, 'A','N m-2', & 'Zonal gravity wave surface stress') - call addfld ('TAUGWY', horiz_only, 'A','N/m2', & + call addfld ('TAUGWY', horiz_only, 'A','N m-2', & 'Meridional gravity wave surface stress') call register_vector_field('TAUGWX', 'TAUGWY') @@ -698,9 +722,9 @@ subroutine gw_init() call addfld ('Frx_DIAG', horiz_only, 'I','1', & 'Obstacle Froude Number') - call addfld('UEGW', (/ 'lev' /) , 'A' ,'1/s' , & + call addfld('UEGW', (/ 'lev' /) , 'A' ,'s-1' , & 'Zonal wind profile-entry to GW ' ) - call addfld('VEGW', (/ 'lev' /) , 'A' ,'1/s' , & + call addfld('VEGW', (/ 'lev' /) , 'A' ,'s-1' , & 'Merdional wind profile-entry to GW ' ) call register_vector_field('UEGW','VEGW') call addfld('TEGW', (/ 'lev' /) , 'A' ,'K' , & @@ -710,32 +734,32 @@ subroutine gw_init() call addfld('ZMGW', (/ 'lev' /) , 'A' ,'m' , & 'midlayer geopotential heights in GW code ' ) - call addfld('TAUM1_DIAG' , (/ 'ilev' /) , 'I' ,'N/m2' , & + call addfld('TAUM1_DIAG' , (/ 'ilev' /) , 'I' ,'N m-2' , & 'Ridge based momentum flux profile') - call addfld('TAU1RDGBETAM' , (/ 'ilev' /) , 'I' ,'N/m2' , & + call addfld('TAU1RDGBETAM' , (/ 'ilev' /) , 'I' ,'N m-2' , & 'Ridge based momentum flux profile') - call addfld('UBM1BETA', (/ 'lev' /) , 'A' ,'1/s' , & + call addfld('UBM1BETA', (/ 'lev' /) , 'A' ,'s-1' , & 'On-ridge wind profile ' ) - call addfld('UBT1RDGBETA' , (/ 'lev' /) , 'I' ,'m/s' , & + call addfld('UBT1RDGBETA' , (/ 'lev' /) , 'I' ,'m s-1' , & 'On-ridge wind tendency from ridge 1 ') do i = 1, 6 write(cn, '(i1)') i - call addfld('TAU'//cn//'RDGBETAY' , (/ 'ilev' /), 'I', 'N/m2', & + call addfld('TAU'//cn//'RDGBETAY' , (/ 'ilev' /), 'I', 'N m-2', & 'Ridge based momentum flux profile') - call addfld('TAU'//cn//'RDGBETAX' , (/ 'ilev' /), 'I', 'N/m2', & + call addfld('TAU'//cn//'RDGBETAX' , (/ 'ilev' /), 'I', 'N m-2', & 'Ridge based momentum flux profile') call register_vector_field('TAU'//cn//'RDGBETAX','TAU'//cn//'RDGBETAY') - call addfld('UT'//cn//'RDGBETA', (/ 'lev' /), 'I', 'm/s', & + call addfld('UT'//cn//'RDGBETA', (/ 'lev' /), 'I', 'm s-1', & 'U wind tendency from ridge '//cn) - call addfld('VT'//cn//'RDGBETA', (/ 'lev' /), 'I', 'm/s', & + call addfld('VT'//cn//'RDGBETA', (/ 'lev' /), 'I', 'm s-1', & 'V wind tendency from ridge '//cn) call register_vector_field('UT'//cn//'RDGBETA','VT'//cn//'RDGBETA') end do - call addfld('TAUARDGBETAY' , (/ 'ilev' /) , 'I' ,'N/m2' , & + call addfld('TAUARDGBETAY' , (/ 'ilev' /) , 'I' ,'N m-2' , & 'Ridge based momentum flux profile') - call addfld('TAUARDGBETAX' , (/ 'ilev' /) , 'I' ,'N/m2' , & + call addfld('TAUARDGBETAX' , (/ 'ilev' /) , 'I' ,'N m-2' , & 'Ridge based momentum flux profile') call register_vector_field('TAUARDGBETAX','TAUARDGBETAY') @@ -798,39 +822,39 @@ subroutine gw_init() call pio_closefile(fh_rdggm) - call addfld ('TAU1RDGGAMMAM' , (/ 'ilev' /) , 'I' ,'N/m2' , & + call addfld ('TAU1RDGGAMMAM' , (/ 'ilev' /) , 'I' ,'N m-2' , & 'Ridge based momentum flux profile') - call addfld ('UBM1GAMMA', (/ 'lev' /) , 'A' ,'1/s' , & + call addfld ('UBM1GAMMA', (/ 'lev' /) , 'A' ,'s-1' , & 'On-ridge wind profile ' ) - call addfld ('UBT1RDGGAMMA' , (/ 'lev' /) , 'I' ,'m/s' , & + call addfld ('UBT1RDGGAMMA' , (/ 'lev' /) , 'I' ,'m s-1' , & 'On-ridge wind tendency from ridge 1 ') do i = 1, 6 write(cn, '(i1)') i - call addfld('TAU'//cn//'RDGGAMMAY', (/ 'ilev' /), 'I', 'N/m2', & + call addfld('TAU'//cn//'RDGGAMMAY', (/ 'ilev' /), 'I', 'N m-2', & 'Ridge based momentum flux profile') - call addfld('TAU'//cn//'RDGGAMMAX', (/ 'ilev' /), 'I', 'N/m2', & + call addfld('TAU'//cn//'RDGGAMMAX', (/ 'ilev' /), 'I', 'N m-2', & 'Ridge based momentum flux profile') - call addfld('UT'//cn//'RDGGAMMA' , (/ 'lev' /), 'I', 'm/s', & + call addfld('UT'//cn//'RDGGAMMA' , (/ 'lev' /), 'I', 'm s-1', & 'U wind tendency from ridge '//cn) - call addfld('VT'//cn//'RDGGAMMA' , (/ 'lev' /), 'I', 'm/s', & + call addfld('VT'//cn//'RDGGAMMA' , (/ 'lev' /), 'I', 'm s-1', & 'V wind tendency from ridge '//cn) call register_vector_field('UT'//cn//'RDGGAMMA','VT'//cn//'RDGGAMMA') end do - call addfld ('TAUARDGGAMMAY' , (/ 'ilev' /) , 'I' ,'N/m2' , & + call addfld ('TAUARDGGAMMAY' , (/ 'ilev' /) , 'I' ,'N m-2' , & 'Ridge based momentum flux profile') - call addfld ('TAUARDGGAMMAX' , (/ 'ilev' /) , 'I' ,'N/m2' , & + call addfld ('TAUARDGGAMMAX' , (/ 'ilev' /) , 'I' ,'N m-2' , & 'Ridge based momentum flux profile') call register_vector_field('TAUARDGGAMMAX','TAUARDGGAMMAY') - call addfld ('TAURDGGMX', horiz_only, 'A','N/m2', & + call addfld ('TAURDGGMX', horiz_only, 'A','N m-2', & 'Zonal gravity wave surface stress') - call addfld ('TAURDGGMY', horiz_only, 'A','N/m2', & + call addfld ('TAURDGGMY', horiz_only, 'A','N m-2', & 'Meridional gravity wave surface stress') call register_vector_field('TAURDGGMX','TAURDGGMY') - call addfld ('UTRDGGM' , (/ 'lev' /) , 'I' ,'m/s' , & + call addfld ('UTRDGGM' , (/ 'lev' /) , 'I' ,'m s-1' , & 'U wind tendency from ridge 6 ') - call addfld ('VTRDGGM' , (/ 'lev' /) , 'I' ,'m/s' , & + call addfld ('VTRDGGM' , (/ 'lev' /) , 'I' ,'m s-1' , & 'V wind tendency from ridge 6 ') call register_vector_field('UTRDGGM','VTRDGGM') end if @@ -841,7 +865,7 @@ subroutine gw_init() frontga_idx = pbuf_get_index('FRONTGA') call shr_assert(unset_r8 /= frontgfc, & - "gw_drag_init: Frontogenesis enabled, but frontgfc was & + "gw_init: Frontogenesis enabled, but frontgfc was & & not set!"// & errMsg(__FILE__, __LINE__)) @@ -874,7 +898,7 @@ subroutine gw_init() if (use_gw_front) then call shr_assert(all(unset_r8 /= [ effgw_cm, taubgnd ]), & - "gw_drag_init: Frontogenesis mid-scale waves enabled, but not & + "gw_init: Frontogenesis mid-scale waves enabled, but not & &all required namelist variables were set!"// & errMsg(__FILE__, __LINE__)) @@ -896,7 +920,7 @@ subroutine gw_init() if (use_gw_front_igw) then call shr_assert(all(unset_r8 /= [ effgw_cm_igw, taubgnd_igw ]), & - "gw_drag_init: Frontogenesis inertial waves enabled, but not & + "gw_init: Frontogenesis inertial waves enabled, but not & &all required namelist variables were set!"// & errMsg(__FILE__, __LINE__)) @@ -915,6 +939,87 @@ subroutine gw_init() end if + ! ========= Moving Mountain initialization! ========================== + if (use_gw_movmtn_pbl) then + + ! get pbuf indices for CLUBB couplings + ttend_clubb_idx = pbuf_get_index('TTEND_CLUBB') + thlp2_clubb_gw_idx = pbuf_get_index('THLP2_CLUBB_GW') + upwp_clubb_gw_idx = pbuf_get_index('UPWP_CLUBB_GW') + vpwp_clubb_gw_idx = pbuf_get_index('VPWP_CLUBB_GW') + wpthlp_clubb_gw_idx = pbuf_get_index('WPTHLP_CLUBB_GW') + + if (masterproc) then + write (iulog,*) 'Moving Mountain development code call init_movmtn' + end if + + + ! Confirm moving mountain file is enabled + call shr_assert(trim(gw_drag_file_mm) /= "", & + "gw_init: No gw_drag_file provided for DP GW moving mountain lookup & + &table. Set this via namelist."// & + errMsg(__FILE__, __LINE__)) + + call gw_init_movmtn(gw_drag_file_mm, band_movmtn, movmtn_desc) + + do k = 0, pver + ! 950 hPa index + if (pref_edge(k+1) < 95000._r8) movmtn_desc%k = k+1 + end do + + ! Don't use deep convection heating depths below this limit. + movmtn_desc%min_hdepth = 1._r8 + if (masterproc) then + write (iulog,*) 'Moving mountain deep level =',movmtn_desc%k + end if + + call addfld ('GWUT_MOVMTN',(/ 'lev' /), 'I','m s-2', & + 'Mov Mtn dragforce - ubm component') + call addfld ('UTGW_MOVMTN',(/ 'lev' /), 'I','m s-2', & + 'Mov Mtn dragforce - u component') + call addfld ('VTGW_MOVMTN',(/ 'lev' /), 'I','m s-2', & + 'Mov Mtn dragforce - v component') + call addfld('TAU_MOVMTN', (/ 'ilev' /), 'I', 'N m-2', & + 'Moving Mountain momentum flux profile') + call addfld('U_MOVMTN_IN', (/ 'lev' /), 'I', 'm s-1', & + 'Moving Mountain - midpoint zonal input wind') + call addfld('V_MOVMTN_IN', (/ 'lev' /), 'I', 'm s-1', & + 'Moving Mountain - midpoint meridional input wind') + call addfld('UBI_MOVMTN', (/ 'ilev' /), 'I', 'm s-1', & + 'Moving Mountain - interface wind in direction of wave') + call addfld('UBM_MOVMTN', (/ 'lev' /), 'I', 'm s-1', & + 'Moving Mountain - midpoint wind in direction of wave') + call addfld ('HDEPTH_MOVMTN',horiz_only,'I','km', & + 'Heating Depth') + call addfld ('UCELL_MOVMTN',horiz_only,'I','m s-1', & + 'Gravity Wave Moving Mountain - Source-level X-wind') + call addfld ('VCELL_MOVMTN',horiz_only,'I','m s-1', & + 'Gravity Wave Moving Mountain - Source-level Y-wind') + call addfld ('CS_MOVMTN',horiz_only,'I','m s-1', & + 'Gravity Wave Moving Mountain - phase speed in direction of wave') + call addfld ('STEER_LEVEL_MOVMTN',horiz_only,'I','1', & + 'Gravity Wave Moving Mountain - steering level for movmtn GW') + call addfld ('SRC_LEVEL_MOVMTN',horiz_only,'I','1', & + 'Gravity Wave Moving Mountain - launch level for movmtn GW') + call addfld ('TND_LEVEL_MOVMTN',horiz_only,'I','1', & + 'Gravity Wave Moving Mountain - tendency lowest level for movmtn GW') + call addfld ('NETDT_MOVMTN',(/ 'lev' /),'I','K s-1', & + 'Gravity Wave Moving Mountain - Net heating rate') + call addfld ('TTEND_CLUBB',(/ 'lev' /),'A','K s-1', & + 'Gravity Wave Moving Mountain - CLUBB Net heating rate') + call addfld ('THLP2_CLUBB_GW',(/ 'ilev' /),'A','K+2', & + 'Gravity Wave Moving Mountain - THLP variance from CLUBB to GW') + call addfld ('WPTHLP_CLUBB_GW',(/ 'ilev' /),'A','Km s-2', & + 'Gravity Wave Moving Mountain - WPTHLP from CLUBB to GW') + call addfld ('UPWP_CLUBB_GW',(/ 'ilev' /),'A','m+2 s-2', & + 'Gravity Wave Moving Mountain - X-momflux from CLUBB to GW') + call addfld ('VPWP_CLUBB_GW',(/ 'ilev' /),'A','m+2 s-2', & + 'Gravity Wave Moving Mountain - Y-momflux from CLUBB to GW') + call addfld ('XPWP_SRC_MOVMTN',horiz_only,'I','m+2 s-2', & + 'Gravity Wave Moving Mountain - flux source for moving mtn') + + end if + if (use_gw_convect_dp) then ttend_dp_idx = pbuf_get_index('TTEND_DP') @@ -938,7 +1043,7 @@ subroutine gw_init() ! Read Beres file. call shr_assert(trim(gw_drag_file) /= "", & - "gw_drag_init: No gw_drag_file provided for Beres deep & + "gw_init: No gw_drag_file provided for Beres deep & &scheme. Set this via namelist."// & errMsg(__FILE__, __LINE__)) @@ -948,9 +1053,9 @@ subroutine gw_init() call gw_spec_addflds(prefix=beres_dp_pf, scheme="Beres (deep)", & band=band_mid, history_defaults=history_waccm) - call addfld ('NETDT',(/ 'lev' /), 'A','K/s', & + call addfld ('NETDT',(/ 'lev' /), 'A','K s-1', & 'Net heating rate') - call addfld ('MAXQ0',horiz_only , 'A','K/day', & + call addfld ('MAXQ0',horiz_only , 'A','K day-1', & 'Max column heating rate') call addfld ('HDEPTH',horiz_only, 'A','km', & 'Heating Depth') @@ -985,7 +1090,7 @@ subroutine gw_init() ! Read Beres file. call shr_assert(trim(gw_drag_file_sh) /= "", & - "gw_drag_init: No gw_drag_file_sh provided for Beres shallow & + "gw_init: No gw_drag_file_sh provided for Beres shallow & &scheme. Set this via namelist."// & errMsg(__FILE__, __LINE__)) @@ -995,9 +1100,9 @@ subroutine gw_init() call gw_spec_addflds(prefix=beres_sh_pf, scheme="Beres (shallow)", & band=band_mid, history_defaults=history_waccm) - call addfld ('SNETDT',(/ 'lev' /), 'A','K/s', & + call addfld ('SNETDT',(/ 'lev' /), 'A','K s-1', & 'Net heating rate') - call addfld ('SMAXQ0',horiz_only , 'A','K/day', & + call addfld ('SMAXQ0',horiz_only , 'A','K day-1', & 'Max column heating rate') call addfld ('SHDEPTH',horiz_only, 'A','km', & 'Heating Depth') @@ -1017,14 +1122,14 @@ subroutine gw_init() call add_default('EKGW', 1, ' ') end if - call addfld ('UTGW_TOTAL', (/ 'lev' /), 'A','m/s2', & + call addfld ('UTGW_TOTAL', (/ 'lev' /), 'A','m s-2', & 'Total U tendency due to gravity wave drag') - call addfld ('VTGW_TOTAL', (/ 'lev' /), 'A','m/s2', & + call addfld ('VTGW_TOTAL', (/ 'lev' /), 'A','m s-2', & 'Total V tendency due to gravity wave drag') call register_vector_field('UTGW_TOTAL', 'VTGW_TOTAL') ! Total temperature tendency output. - call addfld ('TTGW', (/ 'lev' /), 'A', 'K/s', & + call addfld ('TTGW', (/ 'lev' /), 'A', 'K s-1', & 'T tendency - gravity wave drag') ! Water budget terms. @@ -1089,9 +1194,9 @@ subroutine gw_init_beres(file_name, band, desc) integer :: ngwv_file ! Full path to gw_drag_file. - character(len=256) :: file_path + character(len=cl) :: file_path - character(len=256) :: msg + character(len=cl) :: msg !---------------------------------------------------------------------- ! read in look-up table for source spectra @@ -1117,8 +1222,8 @@ subroutine gw_init_beres(file_name, band, desc) ngwv_file = (ngwv_file-1)/2 call shr_assert(ngwv_file >= band%ngwv, & - "gw_beres_init: PS in lookup table file does not cover the whole & - &spectrum implied by the model's ngwv.") + "gw_init_beres: PhaseSpeed in lookup table file does not cover the whole & + &spectrum implied by the model's ngwv. ") ! Allocate hd and get data. @@ -1179,6 +1284,134 @@ subroutine gw_init_beres(file_name, band, desc) end subroutine gw_init_beres +!============================================================== +subroutine gw_init_movmtn(file_name, band, desc) + + use ioFileMod, only: getfil + use pio, only: file_desc_t, pio_nowrite, pio_inq_varid, pio_get_var, & + pio_closefile + use cam_pio_utils, only: cam_pio_openfile + + character(len=*), intent(in) :: file_name + type(GWBand), intent(in) :: band + + type(MovMtnSourceDesc), intent(inout) :: desc + + type(file_desc_t) :: gw_file_desc + + ! PIO variable ids and error code. + integer :: mfccid, uhid, hdid, stat + + ! Number of wavenumbers in the input file. + integer :: ngwv_file + + ! Full path to gw_drag_file. + character(len=cl) :: file_path + + character(len=cl) :: msg + + !---------------------------------------------------------------------- + ! read in look-up table for source spectra + !----------------------------------------------------------------------- + + call getfil(file_name, file_path) + + call cam_pio_openfile(gw_file_desc, file_path, pio_nowrite) + + ! Get HD (heating depth) dimension. + + desc%maxh = 15 !get_pio_dimlen(gw_file_desc, "HD", file_path) + + ! Get MW (mean wind) dimension. + + desc%maxuh = 241 ! get_pio_dimlen(gw_file_desc, "MW", file_path) + + ! Get PS (phase speed) dimension. + + ngwv_file = 0 !get_pio_dimlen(gw_file_desc, "PS", file_path) + + ! Number in each direction is half of total (and minus phase speed of 0). + desc%maxuh = (desc%maxuh-1)/2 + ngwv_file = (ngwv_file-1)/2 + + call shr_assert(ngwv_file >= band%ngwv, & + "gw_movmtn_init: PhaseSpeed in lookup table inconsistent with moving mountain") + + ! Allocate hd and get data. + + allocate(desc%hd(desc%maxh), stat=stat, errmsg=msg) + + call shr_assert(stat == 0, & + "gw_init_movmtn: Allocation error (hd): "//msg// & + errMsg(__FILE__, __LINE__)) + + stat = pio_inq_varid(gw_file_desc,'HDEPTH',hdid) + + call handle_pio_error(stat, & + 'Error finding HD in: '//trim(file_path)) + + stat = pio_get_var(gw_file_desc, hdid, start=[1], count=[desc%maxh], & + ival=desc%hd) + + call handle_pio_error(stat, & + 'Error reading HD from: '//trim(file_path)) + + ! While not currently documented in the file, it uses kilometers. Convert + ! to meters. + desc%hd = desc%hd*1000._r8 + + ! Allocate wind and get data. + + allocate(desc%uh(desc%maxuh), stat=stat, errmsg=msg) + + call shr_assert(stat == 0, & + "gw_init_movmtn: Allocation error (uh): "//msg// & + errMsg(__FILE__, __LINE__)) + + stat = pio_inq_varid(gw_file_desc,'UARR',uhid) + + call handle_pio_error(stat, & + 'Error finding UH in: '//trim(file_path)) + + stat = pio_get_var(gw_file_desc, uhid, start=[1], count=[desc%maxuh], & + ival=desc%uh) + + call handle_pio_error(stat, & + 'Error reading UH from: '//trim(file_path)) + + ! Allocate mfcc. "desc%maxh" and "desc%maxuh" are from the file, but the + ! model determines wavenumber dimension. + + allocate(desc%mfcc(desc%maxh,-desc%maxuh:desc%maxuh,& + -band%ngwv:band%ngwv), stat=stat, errmsg=msg) + + call shr_assert(stat == 0, & + "gw_init_movmtn: Allocation error (mfcc): "//msg// & + errMsg(__FILE__, __LINE__)) + + ! Get mfcc data. + + stat = pio_inq_varid(gw_file_desc,'NEWMF',mfccid) + + call handle_pio_error(stat, & + 'Error finding mfcc in: '//trim(file_path)) + + stat = pio_get_var(gw_file_desc, mfccid, & + start=[1,1], count=shape(desc%mfcc), & + ival=desc%mfcc) + + call handle_pio_error(stat, & + 'Error reading mfcc from: '//trim(file_path)) + + call pio_closefile(gw_file_desc) + + if (masterproc) then + + write(iulog,*) "Read in Mov Mountain source file." + + endif + +end subroutine gw_init_movmtn !========================================================================== ! Utility to reduce the repetitiveness of reads during initialization. @@ -1244,6 +1477,7 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) use gw_oro, only: gw_oro_src use gw_front, only: gw_cm_src use gw_convect, only: gw_beres_src + use gw_movmtn, only: gw_movmtn_src !------------------------------Arguments-------------------------------- type(physics_state), intent(in) :: state ! physics state structure @@ -1260,6 +1494,7 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) integer :: lchnk ! chunk identifier integer :: ncol ! number of atmospheric columns + integer :: istat integer :: i, k ! loop indices @@ -1294,7 +1529,7 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) real(r8) :: dttke(state%ncol,pver) ! Wave phase speeds for each column - real(r8), allocatable :: c(:,:) + real(r8), allocatable :: phase_speeds(:,:) ! Efficiency for a gravity wave source. real(r8) :: effgw(state%ncol) @@ -1319,6 +1554,15 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Temperature change due to shallow convection. real(r8), pointer :: ttend_sh(:,:) + ! New couplings from CLUBB + real(r8), pointer :: ttend_clubb(:,:) + real(r8), pointer :: thlp2_clubb_gw(:,:) + real(r8), pointer :: wpthlp_clubb_gw(:,:) + real(r8), pointer :: upwp_clubb_gw(:,:) + real(r8), pointer :: vpwp_clubb_gw(:,:) + real(r8) :: xpwp_clubb(state%ncol,pver+1) + + ! Standard deviation of orography. real(r8), pointer :: sgh(:) @@ -1390,6 +1634,7 @@ 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. @@ -1454,15 +1699,111 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) egwdffi_tot = 0._r8 flx_heat = 0._r8 + if (use_gw_movmtn_pbl) then + !------------------------------------------------------------------ + !Convective moving mountain gravity waves (Beres scheme). + !------------------------------------------------------------------ + + call outfld('U_MOVMTN_IN', u, ncol, lchnk) + call outfld('V_MOVMTN_IN', v, ncol, lchnk) + + ! Allocate wavenumber fields. + allocate(tau(ncol,-band_movmtn%ngwv:band_movmtn%ngwv,pver+1),stat=istat) + call alloc_err(istat,'gw_tend','tau',ncol*(band_movmtn%ngwv**2+1)*(pver+1)) + allocate(gwut(ncol,pver,-band_movmtn%ngwv:band_movmtn%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','gwut',ncol*pver*band_movmtn%ngwv**2+1) + allocate(phase_speeds(ncol,-band_movmtn%ngwv:band_movmtn%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','phase_speeds',ncol*band_movmtn%ngwv**2+1) + + ! Set up heating + call pbuf_get_field(pbuf, ttend_dp_idx, ttend_dp) + + ! New couplings from CLUBB + call pbuf_get_field(pbuf, ttend_clubb_idx, ttend_clubb) + call pbuf_get_field(pbuf, thlp2_clubb_gw_idx, thlp2_clubb_gw) + call pbuf_get_field(pbuf, wpthlp_clubb_gw_idx, wpthlp_clubb_gw) + call pbuf_get_field(pbuf, upwp_clubb_gw_idx, upwp_clubb_gw) + call pbuf_get_field(pbuf, vpwp_clubb_gw_idx, vpwp_clubb_gw) + + xpwp_clubb(:ncol,:) = sqrt( upwp_clubb_gw(:ncol,:)**2 + vpwp_clubb_gw(:ncol,:)**2 ) + + effgw = 1._r8 + call gw_movmtn_src(ncol, lchnk, band_movmtn , movmtn_desc, & + u, v, ttend_dp(:ncol,:), ttend_clubb(:ncol,:), xpwp_clubb(:ncol,:) , & + zm, alpha_gw_movmtn, src_level, tend_level, & + tau, ubm, ubi, xv, yv, & + phase_speeds, hdepth) + !------------------------------------------------------------- + ! gw_movmtn_src returns wave-relative wind profiles ubm,ubi + ! and unit vector components describing direction of wavevector + ! and application of wave-drag force. I believe correct setting + ! for c is c=0, since it is incorporated in ubm and (xv,yv) + !-------------------------------------------------------------- + + call outfld('SRC_LEVEL_MOVMTN', real(src_level,r8), ncol, lchnk) + call outfld('TND_LEVEL_MOVMTN', real(tend_level,r8), ncol, lchnk) + call outfld('UBI_MOVMTN', ubi, ncol, lchnk) + call outfld('UBM_MOVMTN', ubm, ncol, lchnk) + + call gw_drag_prof(ncol, band_movmtn, p, src_level, tend_level, dt, & + t, vramp, & + piln, rhoi, nm, ni, ubm, ubi, xv, yv, & + effgw, phase_speeds, kvtt, q, dse, tau, utgw, vtgw, & + ttgw, qtgw, egwdffi, gwut, dttdf, dttke, & + lapply_effgw_in=gw_apply_tndmax ) + + ! Project stress into directional components. + taucd = calc_taucd(ncol, band_movmtn%ngwv, tend_level, tau, phase_speeds, xv, yv, ubi) + + ! add the diffusion coefficients + do k = 1, pver+1 + egwdffi_tot(:,k) = egwdffi_tot(:,k) + egwdffi(:,k) + end do + + ! Store constituents tendencies + do m=1, pcnst + do k = 1, pver + ptend%q(:ncol,k,m) = ptend%q(:ncol,k,m) + qtgw(:,k,m) + end do + end do + + ! Add the momentum tendencies to the output tendency arrays. + do k = 1, pver + ptend%u(:ncol,k) = ptend%u(:ncol,k) + utgw(:,k) + ptend%v(:ncol,k) = ptend%v(:ncol,k) + vtgw(:,k) + end do + + do k = 1, pver + ptend%s(:ncol,k) = ptend%s(:ncol,k) + ttgw(:,k) + end do + + call outfld('TAU_MOVMTN', tau(:,0,:), ncol, lchnk) + call outfld('GWUT_MOVMTN', gwut(:,:,0), ncol, lchnk) + call outfld('VTGW_MOVMTN', vtgw, ncol, lchnk) + call outfld('UTGW_MOVMTN', utgw, ncol, lchnk) + call outfld('HDEPTH_MOVMTN', hdepth/1000._r8, ncol, lchnk) + call outfld('NETDT_MOVMTN', ttend_dp, pcols, lchnk) + call outfld('TTEND_CLUBB', ttend_clubb, pcols, lchnk) + call outfld('THLP2_CLUBB_GW', thlp2_clubb_gw, pcols, lchnk) + call outfld('WPTHLP_CLUBB_GW', wpthlp_clubb_gw, pcols, lchnk) + call outfld('UPWP_CLUBB_GW', upwp_clubb_gw, pcols, lchnk) + call outfld('VPWP_CLUBB_GW', vpwp_clubb_gw, pcols, lchnk) + + deallocate(tau, gwut, phase_speeds) + end if + if (use_gw_convect_dp) then !------------------------------------------------------------------ ! Convective gravity waves (Beres scheme, deep). !------------------------------------------------------------------ ! Allocate wavenumber fields. - allocate(tau(ncol,-band_mid%ngwv:band_mid%ngwv,pver+1)) - allocate(gwut(ncol,pver,-band_mid%ngwv:band_mid%ngwv)) - allocate(c(ncol,-band_mid%ngwv:band_mid%ngwv)) + allocate(tau(ncol,-band_mid%ngwv:band_mid%ngwv,pver+1),stat=istat) + call alloc_err(istat,'gw_tend','tau',ncol*(band_mid%ngwv**2+1)*(pver+1)) + allocate(gwut(ncol,pver,-band_mid%ngwv:band_mid%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','gwut',ncol*pver*(band_mid%ngwv**2+1)) + allocate(phase_speeds(ncol,-band_mid%ngwv:band_mid%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','tau',ncol*(band_mid%ngwv**2+1)) ! Set up heating call pbuf_get_field(pbuf, ttend_dp_idx, ttend_dp) @@ -1478,18 +1819,18 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Determine wave sources for Beres deep scheme call gw_beres_src(ncol, band_mid, beres_dp_desc, & u, v, ttend_dp(:ncol,:), zm, src_level, tend_level, tau, & - ubm, ubi, xv, yv, c, hdepth, maxq0) + ubm, ubi, xv, yv, phase_speeds, hdepth, maxq0) ! Solve for the drag profile with Beres source spectrum. call gw_drag_prof(ncol, band_mid, p, src_level, tend_level, dt, & t, vramp, & piln, rhoi, nm, ni, ubm, ubi, xv, yv, & - effgw, c, kvtt, q, dse, tau, utgw, vtgw, & + effgw, phase_speeds, kvtt, q, dse, tau, utgw, vtgw, & ttgw, qtgw, egwdffi, gwut, dttdf, dttke, & lapply_effgw_in=gw_apply_tndmax) ! Project stress into directional components. - taucd = calc_taucd(ncol, band_mid%ngwv, tend_level, tau, c, xv, yv, ubi) + taucd = calc_taucd(ncol, band_mid%ngwv, tend_level, tau, phase_speeds, xv, yv, ubi) ! add the diffusion coefficients do k = 1, pver+1 @@ -1526,7 +1867,7 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Change ttgw to a temperature tendency before outputing it. ttgw = ttgw / cpair - call gw_spec_outflds(beres_dp_pf, lchnk, ncol, band_mid, c, u, v, & + call gw_spec_outflds(beres_dp_pf, lchnk, ncol, band_mid, phase_speeds, u, v, & xv, yv, gwut, dttdf, dttke, tau(:,:,2:), utgw, vtgw, ttgw, & taucd) @@ -1535,7 +1876,7 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) call outfld('HDEPTH', hdepth/1000._r8, ncol, lchnk) call outfld('MAXQ0', maxq0, ncol, lchnk) - deallocate(tau, gwut, c) + deallocate(tau, gwut, phase_speeds) end if @@ -1545,9 +1886,12 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) !------------------------------------------------------------------ ! Allocate wavenumber fields. - allocate(tau(ncol,-band_mid%ngwv:band_mid%ngwv,pver+1)) - allocate(gwut(ncol,pver,-band_mid%ngwv:band_mid%ngwv)) - allocate(c(ncol,-band_mid%ngwv:band_mid%ngwv)) + allocate(tau(ncol,-band_mid%ngwv:band_mid%ngwv,pver+1),stat=istat) + call alloc_err(istat,'gw_tend','tau',ncol*(band_mid%ngwv**2+1)*(pver+1)) + allocate(gwut(ncol,pver,-band_mid%ngwv:band_mid%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','gwut',ncol*pver*(band_mid%ngwv**2+1)) + allocate(phase_speeds(ncol,-band_mid%ngwv:band_mid%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','phase_speeds',ncol*(band_mid%ngwv**2+1)) ! Set up heating call pbuf_get_field(pbuf, ttend_sh_idx, ttend_sh) @@ -1563,18 +1907,18 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Determine wave sources for Beres shallow scheme call gw_beres_src(ncol, band_mid, beres_sh_desc, & u, v, ttend_sh(:ncol,:), zm, src_level, tend_level, tau, & - ubm, ubi, xv, yv, c, hdepth, maxq0) + ubm, ubi, xv, yv, phase_speeds, hdepth, maxq0) ! Solve for the drag profile with Beres source spectrum. call gw_drag_prof(ncol, band_mid, p, src_level, tend_level, dt, & t, vramp, & piln, rhoi, nm, ni, ubm, ubi, xv, yv, & - effgw, c, kvtt, q, dse, tau, utgw, vtgw, & + effgw, phase_speeds, kvtt, q, dse, tau, utgw, vtgw, & ttgw, qtgw, egwdffi, gwut, dttdf, dttke, & lapply_effgw_in=gw_apply_tndmax) ! Project stress into directional components. - taucd = calc_taucd(ncol, band_mid%ngwv, tend_level, tau, c, xv, yv, ubi) + taucd = calc_taucd(ncol, band_mid%ngwv, tend_level, tau, phase_speeds, xv, yv, ubi) ! add the diffusion coefficients do k = 1, pver+1 @@ -1607,7 +1951,7 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Change ttgw to a temperature tendency before outputing it. ttgw = ttgw / cpair - call gw_spec_outflds(beres_sh_pf, lchnk, ncol, band_mid, c, u, v, & + call gw_spec_outflds(beres_sh_pf, lchnk, ncol, band_mid, phase_speeds, u, v, & xv, yv, gwut, dttdf, dttke, tau(:,:,2:), utgw, vtgw, ttgw, & taucd) @@ -1616,7 +1960,7 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) call outfld ('SHDEPTH', hdepth/1000._r8, ncol, lchnk) call outfld ('SMAXQ0', maxq0, ncol, lchnk) - deallocate(tau, gwut, c) + deallocate(tau, gwut, phase_speeds) end if @@ -1636,9 +1980,12 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) !------------------------------------------------------------------ ! Allocate wavenumber fields. - allocate(tau(ncol,-band_mid%ngwv:band_mid%ngwv,pver+1)) - allocate(gwut(ncol,pver,-band_mid%ngwv:band_mid%ngwv)) - allocate(c(ncol,-band_mid%ngwv:band_mid%ngwv)) + allocate(tau(ncol,-band_mid%ngwv:band_mid%ngwv,pver+1),stat=istat) + call alloc_err(istat,'gw_tend','tau',ncol*(band_mid%ngwv**2+1)*(pver+1)) + allocate(gwut(ncol,pver,-band_mid%ngwv:band_mid%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','gwut',ncol*pver*(band_mid%ngwv**2+1)) + allocate(phase_speeds(ncol,-band_mid%ngwv:band_mid%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','tau',ncol*(band_mid%ngwv**2+1)) ! Efficiency of gravity wave momentum transfer. effgw = effgw_cm @@ -1648,18 +1995,18 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Determine the wave source for C&M background spectrum call gw_cm_src(ncol, band_mid, cm_desc, u, v, frontgf(:ncol,:), & - src_level, tend_level, tau, ubm, ubi, xv, yv, c) + src_level, tend_level, tau, ubm, ubi, xv, yv, phase_speeds) ! Solve for the drag profile with C&M source spectrum. call gw_drag_prof(ncol, band_mid, p, src_level, tend_level, dt, & t, vramp, & piln, rhoi, nm, ni, ubm, ubi, xv, yv, & - effgw, c, kvtt, q, dse, tau, utgw, vtgw, & + effgw, phase_speeds, kvtt, q, dse, tau, utgw, vtgw, & ttgw, qtgw, egwdffi, gwut, dttdf, dttke, & lapply_effgw_in=gw_apply_tndmax) ! Project stress into directional components. - taucd = calc_taucd(ncol, band_mid%ngwv, tend_level, tau, c, xv, yv, ubi) + taucd = calc_taucd(ncol, band_mid%ngwv, tend_level, tau, phase_speeds, xv, yv, ubi) ! add the diffusion coefficients do k = 1, pver+1 @@ -1696,11 +2043,11 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Change ttgw to a temperature tendency before outputing it. ttgw = ttgw / cpair - call gw_spec_outflds(cm_pf, lchnk, ncol, band_mid, c, u, v, & + call gw_spec_outflds(cm_pf, lchnk, ncol, band_mid, phase_speeds, u, v, & xv, yv, gwut, dttdf, dttke, tau(:,:,2:), utgw, vtgw, ttgw, & taucd) - deallocate(tau, gwut, c) + deallocate(tau, gwut, phase_speeds) end if @@ -1710,10 +2057,14 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) !------------------------------------------------------------------ ! Allocate wavenumber fields. - allocate(tau(ncol,-band_long%ngwv:band_long%ngwv,pver+1)) - allocate(gwut(ncol,pver,-band_long%ngwv:band_long%ngwv)) - allocate(c(ncol,-band_long%ngwv:band_long%ngwv)) - allocate(ro_adjust(ncol,-band_long%ngwv:band_long%ngwv,pver+1)) + allocate(tau(ncol,-band_long%ngwv:band_long%ngwv,pver+1),stat=istat) + call alloc_err(istat,'gw_tend','tau',ncol*(band_long%ngwv**2+1)*(pver+1)) + allocate(gwut(ncol,pver,-band_long%ngwv:band_long%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','gwut',ncol*pver*(band_long%ngwv**2+1)) + allocate(phase_speeds(ncol,-band_long%ngwv:band_long%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','phase_speeds',ncol*(band_long%ngwv**2+1)) + allocate(ro_adjust(ncol,-band_long%ngwv:band_long%ngwv,pver+1),stat=istat) + call alloc_err(istat,'gw_tend','ro_adjust',ncol*(band_long%ngwv**2+1)*(pver+1)) ! Efficiency of gravity wave momentum transfer. effgw = effgw_cm_igw @@ -1732,21 +2083,21 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Determine the wave source for C&M background spectrum call gw_cm_src(ncol, band_long, cm_igw_desc, u, v, frontgf(:ncol,:), & - src_level, tend_level, tau, ubm, ubi, xv, yv, c) + src_level, tend_level, tau, ubm, ubi, xv, yv, phase_speeds) - call adjust_inertial(band_long, tend_level, u_coriolis, c, ubi, & + call adjust_inertial(band_long, tend_level, u_coriolis, phase_speeds, ubi, & tau, ro_adjust) ! Solve for the drag profile with C&M source spectrum. call gw_drag_prof(ncol, band_long, p, src_level, tend_level, dt, & t, vramp, & piln, rhoi, nm, ni, ubm, ubi, xv, yv, & - effgw, c, kvtt, q, dse, tau, utgw, vtgw, & + effgw, phase_speeds, kvtt, q, dse, tau, utgw, vtgw, & ttgw, qtgw, egwdffi, gwut, dttdf, dttke, ro_adjust=ro_adjust, & lapply_effgw_in=gw_apply_tndmax) ! Project stress into directional components. - taucd = calc_taucd(ncol, band_long%ngwv, tend_level, tau, c, xv, yv, ubi) + taucd = calc_taucd(ncol, band_long%ngwv, tend_level, tau, phase_speeds, xv, yv, ubi) ! add the diffusion coefficients do k = 1, pver+1 @@ -1783,11 +2134,11 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Change ttgw to a temperature tendency before outputing it. ttgw = ttgw / cpair - call gw_spec_outflds(cm_igw_pf, lchnk, ncol, band_long, c, u, v, & + call gw_spec_outflds(cm_igw_pf, lchnk, ncol, band_long, phase_speeds, u, v, & xv, yv, gwut, dttdf, dttke, tau(:,:,2:), utgw, vtgw, ttgw, & taucd) - deallocate(tau, gwut, c, ro_adjust) + deallocate(tau, gwut, phase_speeds, ro_adjust) end if @@ -1797,9 +2148,12 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) !--------------------------------------------------------------------- ! Allocate wavenumber fields. - allocate(tau(ncol,band_oro%ngwv:band_oro%ngwv,pver+1)) - allocate(gwut(ncol,pver,band_oro%ngwv:band_oro%ngwv)) - allocate(c(ncol,band_oro%ngwv:band_oro%ngwv)) + allocate(tau(ncol,band_oro%ngwv:band_oro%ngwv,pver+1),stat=istat) + call alloc_err(istat,'gw_tend','tau',ncol*(band_oro%ngwv**2+1)*(pver+1)) + allocate(gwut(ncol,pver,band_oro%ngwv:band_oro%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','gwut',ncol*pver*(band_oro%ngwv**2+1)) + allocate(phase_speeds(ncol,band_oro%ngwv:band_oro%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','phase_speeds',ncol*(band_oro%ngwv**2+1)) ! Efficiency of gravity wave momentum transfer. ! Take into account that wave sources are only over land. @@ -1817,14 +2171,14 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Determine the orographic wave source call gw_oro_src(ncol, band_oro, p, & u, v, t, sgh_scaled, zm, nm, & - src_level, tend_level, tau, ubm, ubi, xv, yv, c) + src_level, tend_level, tau, ubm, ubi, xv, yv, phase_speeds) else effgw = effgw_oro ! Determine the orographic wave source call gw_oro_src(ncol, band_oro, p, & u, v, t, sgh(:ncol), zm, nm, & - src_level, tend_level, tau, ubm, ubi, xv, yv, c) + src_level, tend_level, tau, ubm, ubi, xv, yv, phase_speeds) endif do i = 1, ncol if (state1%lat(i) < 0._r8) then @@ -1836,7 +2190,7 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) call gw_drag_prof(ncol, band_oro, p, src_level, tend_level, dt, & t, vramp, & piln, rhoi, nm, ni, ubm, ubi, xv, yv, & - effgw,c, kvtt, q, dse, tau, utgw, vtgw, & + effgw, phase_speeds, kvtt, q, dse, tau, utgw, vtgw, & ttgw, qtgw, egwdffi, gwut, dttdf, dttke, & lapply_effgw_in=gw_apply_tndmax) @@ -1885,7 +2239,7 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) call outfld('TAUGWX', tau0x, ncol, lchnk) call outfld('TAUGWY', tau0y, ncol, lchnk) - deallocate(tau, gwut, c) + deallocate(tau, gwut, phase_speeds) end if @@ -2040,13 +2394,13 @@ subroutine gw_rdg_calc( & !---------------------------Local storage------------------------------- - integer :: k, m, nn + integer :: k, m, nn, istat real(r8), allocatable :: tau(:,:,:) ! wave Reynolds stress ! gravity wave wind tendency for each wave real(r8), allocatable :: gwut(:,:,:) ! Wave phase speeds for each column - real(r8), allocatable :: c(:,:) + real(r8), allocatable :: phase_speeds(:,:) ! Isotropic source flag [anisotropic orography]. integer :: isoflag(ncol) @@ -2139,9 +2493,12 @@ subroutine gw_rdg_calc( & !---------------------------------------------------------------------------- ! Allocate wavenumber fields. - allocate(tau(ncol,band_oro%ngwv:band_oro%ngwv,pver+1)) - allocate(gwut(ncol,pver,band_oro%ngwv:band_oro%ngwv)) - allocate(c(ncol,band_oro%ngwv:band_oro%ngwv)) + allocate(tau(ncol,band_oro%ngwv:band_oro%ngwv,pver+1),stat=istat) + call alloc_err(istat,'gw_rdg_calc','tau',ncol*(band_oro%ngwv**2+1)*(pver+1)) + allocate(gwut(ncol,pver,band_oro%ngwv:band_oro%ngwv),stat=istat) + call alloc_err(istat,'rdg_calc','gwut',ncol*pver*(band_oro%ngwv**2+1)) + allocate(phase_speeds(ncol,band_oro%ngwv:band_oro%ngwv),stat=istat) + call alloc_err(istat,'rdg_calc','phase_speeds',ncol*(band_oro%ngwv**2+1)) ! initialize accumulated momentum fluxes and tendencies taurx = 0._r8 @@ -2160,7 +2517,7 @@ subroutine gw_rdg_calc( & call gw_rdg_src(ncol, band_oro, p, & u, v, t, mxdis(:,nn), angll(:,nn), anixy(:,nn), kwvrdg, isoflag, zi, nm, & src_level, tend_level, bwv_level, tlb_level, tau, ubm, ubi, xv, yv, & - ubmsrc, usrc, vsrc, nsrc, rsrc, m2src, tlb, bwv, Fr1, Fr2, Frx, c) + ubmsrc, usrc, vsrc, nsrc, rsrc, m2src, tlb, bwv, Fr1, Fr2, Frx, phase_speeds) call gw_rdg_belowpeak(ncol, band_oro, rdg_cd_llb, & t, mxdis(:,nn), anixy(:,nn), kwvrdg, & @@ -2180,7 +2537,7 @@ subroutine gw_rdg_calc( & call gw_drag_prof(ncol, band_oro, p, src_level, tend_level, dt, & t, vramp, & piln, rhoi, nm, ni, ubm, ubi, xv, yv, & - effgw, c, kvtt, q, dse, tau, utgw, vtgw, & + effgw, phase_speeds, kvtt, q, dse, tau, utgw, vtgw, & ttgw, qtgw, egwdffi, gwut, dttdf, dttke, & kwvrdg=kwvrdg, & satfac_in = 1._r8, lapply_vdiff=gw_rdg_do_vdiff , tau_diag=tau_diag ) @@ -2276,7 +2633,7 @@ subroutine gw_rdg_calc( & call outfld(fname(4), vtrdg, ncol, lchnk) call outfld('TTGWORO', ttrdg / cpair, ncol, lchnk) - deallocate(tau, gwut, c) + deallocate(tau, gwut, phase_speeds) end subroutine gw_rdg_calc @@ -2310,25 +2667,25 @@ subroutine gw_spec_addflds(prefix, scheme, band, history_defaults) !----------------------------------------------------------------------- ! Overall wind tendencies. - call addfld (trim(prefix)//'UTGWSPEC',(/ 'lev' /), 'A','m/s2', & + call addfld (trim(prefix)//'UTGWSPEC',(/ 'lev' /), 'A','m s-2', & trim(scheme)//' U tendency - gravity wave spectrum') - call addfld (trim(prefix)//'VTGWSPEC',(/ 'lev' /), 'A','m/s2', & + call addfld (trim(prefix)//'VTGWSPEC',(/ 'lev' /), 'A','m s-2', & trim(scheme)//' V tendency - gravity wave spectrum') call register_vector_field(trim(prefix)//'UTGWSPEC',trim(prefix)//'VTGWSPEC') - call addfld (trim(prefix)//'TTGWSPEC',(/ 'lev' /), 'A','K/s', & + call addfld (trim(prefix)//'TTGWSPEC',(/ 'lev' /), 'A','K s-1', & trim(scheme)//' T tendency - gravity wave spectrum') ! Wind tendencies broken across five spectral bins. - call addfld (trim(prefix)//'UTEND1', (/ 'lev' /), 'A','m/s2', & + call addfld (trim(prefix)//'UTEND1', (/ 'lev' /), 'A','m s-2', & trim(scheme)//' U tendency c < -40') - call addfld (trim(prefix)//'UTEND2', (/ 'lev' /), 'A','m/s2', & + call addfld (trim(prefix)//'UTEND2', (/ 'lev' /), 'A','m s-2', & trim(scheme)//' U tendency -40 < c < -15') - call addfld (trim(prefix)//'UTEND3', (/ 'lev' /), 'A','m/s2', & + call addfld (trim(prefix)//'UTEND3', (/ 'lev' /), 'A','m s-2', & trim(scheme)//' U tendency -15 < c < 15') - call addfld (trim(prefix)//'UTEND4', (/ 'lev' /), 'A','m/s2', & + call addfld (trim(prefix)//'UTEND4', (/ 'lev' /), 'A','m s-2', & trim(scheme)//' U tendency 15 < c < 40') - call addfld (trim(prefix)//'UTEND5', (/ 'lev' /), 'A','m/s2', & + call addfld (trim(prefix)//'UTEND5', (/ 'lev' /), 'A','m s-2', & trim(scheme)//' U tendency 40 < c ') ! Reynold's stress toward each cardinal direction, and net zonal stress. @@ -2354,9 +2711,9 @@ subroutine gw_spec_addflds(prefix, scheme, band, history_defaults) trim(scheme)//' Southward MF') ! Temperature tendency terms. - call addfld (trim(prefix)//'TTGWSDF' , (/ 'lev' /), 'A','K/s', & + call addfld (trim(prefix)//'TTGWSDF' , (/ 'lev' /), 'A','K s-1', & trim(scheme)//' t tendency - diffusion term') - call addfld (trim(prefix)//'TTGWSKE' , (/ 'lev' /), 'A','K/s', & + call addfld (trim(prefix)//'TTGWSKE' , (/ 'lev' /), 'A','K s-1', & trim(scheme)//' t tendency - kinetic energy conversion term') ! Gravity wave source spectra by wave number. @@ -2366,7 +2723,7 @@ subroutine gw_spec_addflds(prefix, scheme, band, history_defaults) dumc1x = tau_fld_name(l, prefix, x_not_y=.true.) dumc1y = tau_fld_name(l, prefix, x_not_y=.false.) - dumc2 = trim(scheme)//" tau at c= "//trim(fnum)//" m/s" + dumc2 = trim(scheme)//" tau at c= "//trim(fnum)//" m s-1" call addfld (trim(dumc1x),(/ 'lev' /), 'A','Pa',dumc2) call addfld (trim(dumc1y),(/ 'lev' /), 'A','Pa',dumc2) @@ -2388,7 +2745,7 @@ end subroutine gw_spec_addflds !========================================================================== ! Outputs for spectral waves. -subroutine gw_spec_outflds(prefix, lchnk, ncol, band, c, u, v, xv, yv, & +subroutine gw_spec_outflds(prefix, lchnk, ncol, band, phase_speeds, u, v, xv, yv, & gwut, dttdf, dttke, tau, utgw, vtgw, ttgw, taucd) use gw_common, only: west, east, south, north @@ -2401,7 +2758,7 @@ subroutine gw_spec_outflds(prefix, lchnk, ncol, band, c, u, v, xv, yv, & ! Wave speeds. type(GWBand), intent(in) :: band ! Wave phase speeds for each column. - real(r8), intent(in) :: c(ncol,-band%ngwv:band%ngwv) + real(r8), intent(in) :: phase_speeds(ncol,-band%ngwv:band%ngwv) ! Winds at cell midpoints. real(r8), intent(in) :: u(ncol,pver) real(r8), intent(in) :: v(ncol,pver) @@ -2453,7 +2810,7 @@ subroutine gw_spec_outflds(prefix, lchnk, ncol, band, c, u, v, xv, yv, & utb = 0._r8 ! Find which output bin the phase speed corresponds to. - ix = find_bin(c) + ix = find_bin(phase_speeds) ! Put the wind tendency in that bin. do l = -band%ngwv, band%ngwv @@ -2487,12 +2844,12 @@ subroutine gw_spec_outflds(prefix, lchnk, ncol, band, c, u, v, xv, yv, & taux = 0._r8 tauy = 0._r8 - ! Project c, and convert each component to a wavenumber index. + ! Project phase_speeds, and convert each component to a wavenumber index. ! These are mappings from the wavenumber index of tau to those of taux ! and tauy, respectively. do l=-band%ngwv,band%ngwv - ix(:,l) = c_to_l(c(:,l)*xv) - iy(:,l) = c_to_l(c(:,l)*yv) + ix(:,l) = c_to_l(phase_speeds(:,l)*xv) + iy(:,l) = c_to_l(phase_speeds(:,l)*yv) end do ! Find projection of tau. diff --git a/src/physics/cam/gw_movmtn.F90 b/src/physics/cam/gw_movmtn.F90 new file mode 100644 index 0000000000..0408928932 --- /dev/null +++ b/src/physics/cam/gw_movmtn.F90 @@ -0,0 +1,444 @@ +module gw_movmtn + +! +! This module parameterizes gravity waves generated by the obstacle effect produced by +! boundary layer turbulence for convection. +! + +use gw_utils, only: r8 + +implicit none +private +save + +public :: MovMtnSourceDesc +public :: gw_movmtn_src + +type :: MovMtnSourceDesc + ! Whether wind speeds are shifted to be relative to storm cells. + logical :: storm_shift + ! Index for level where wind speed is used as the source speed. + integer :: k + ! Heating depths below this value [m] will be ignored. + real(r8) :: min_hdepth + ! Table bounds, for convenience. (Could be inferred from shape(mfcc).) + integer :: maxh !-bounds of the lookup table heating depths + integer :: maxuh ! bounds of the lookup table wind + ! Heating depths [m]. + real(r8), allocatable :: hd(:), uh(:) + ! Table of source spectra. + real(r8), allocatable :: mfcc(:,:,:) !is the lookup table f(depth, wind, phase speed) +end type MovMtnSourceDesc + +contains + +!========================================================================== + +subroutine gw_movmtn_src(ncol,lchnk, band, desc, u, v, & + netdt, netdt_shcu, xpwp_shcu, & + zm, alpha_gw_movmtn, src_level, tend_level, tau, ubm, ubi, xv, yv, & + c, hdepth) +!----------------------------------------------------------------------- +! Flexible driver for gravity wave source from obstacle effects produced +! by boundary layer turbulence or deep convection +!----------------------------------------------------------------------- + use gw_utils, only: get_unit_vector, dot_2d, midpoint_interp + use gw_common, only: GWBand, pver, qbo_hdepth_scaling + use cam_history, only: outfld + use phys_control, only: use_gw_movmtn_pbl + use physconst, only: rair, gravit +!------------------------------Arguments-------------------------------- + ! Column dimension. + integer, intent(in) :: ncol , lchnk + + ! Wavelengths triggered by convection. + type(GWBand), intent(in) :: band + + ! Settings for convection type (e.g. deep vs shallow). + type(MovMtnSourceDesc), intent(in) :: desc + + ! Midpoint zonal/meridional winds. + real(r8), intent(in) :: u(ncol,pver), v(ncol,pver) + ! Heating rate due to convection. + real(r8), intent(in) :: netdt(:,:) !from deep scheme + ! Heating rate due to shallow convection and PBL turbulence. + real(r8), intent(in) :: netdt_shcu(:,:) + ! Higher order flux from ShCu/PBL. + real(r8), intent(in) :: xpwp_shcu(ncol,pver+1) + ! Midpoint altitudes. + real(r8), intent(in) :: zm(ncol,pver) + ! tunable parameter controlling proportion of PBL momentum flux emitted as GW + real(r8), intent(in) :: alpha_gw_movmtn + + ! Indices of top gravity wave source level and lowest level where wind + ! tendencies are allowed. + integer, intent(out) :: src_level(ncol) + integer, intent(out) :: tend_level(ncol) + + ! Wave Reynolds stress. + real(r8), intent(out) :: tau(ncol,-band%ngwv:band%ngwv,pver+1) !tau = momentum flux (m2/s2) at interface level ngwv = band of phase speeds + ! Projection of wind at midpoints and interfaces. + real(r8), intent(out) :: ubm(ncol,pver), ubi(ncol,pver+1) + ! Unit vectors of source wind (zonal and meridional components). + real(r8), intent(out) :: xv(ncol), yv(ncol) !determined by vector direction of wind at source + ! Phase speeds. + real(r8), intent(out) :: c(ncol,-band%ngwv:band%ngwv) + + ! Heating depth [m] and maximum heating in each column. + real(r8), intent(out) :: hdepth(ncol) !calculated here in this code + +!---------------------------Local Storage------------------------------- + ! Column and (vertical) level indices. + integer :: i, k + + ! Zonal/meridional wind at steering level, i.e., 'cell speed'. + ! May be later modified by retrograde motion .... + real(r8) :: usteer(ncol), vsteer(ncol) + real(r8) :: uwavef(ncol,pver),vwavef(ncol,pver) + ! Steering level (integer converted to real*8) + real(r8) :: steer_level(ncol) + ! Retrograde motion of Cell + real(r8) :: Cell_Retro_Speed(ncol) + + ! Maximum heating rate. + real(r8) :: q0(ncol), qj(ncol) + ! unit vector components at steering level and mag + real(r8) :: xv_steer(ncol), yv_steer(ncol), umag_steer(ncol) + ! Bottom/top heating range index. + integer :: boti(ncol), topi(ncol) + ! Index for looking up heating depth dimension in the table. + integer :: hd_idx(ncol) + ! Mean wind in heating region. + real(r8) :: uh(ncol) + ! Min/max wavenumber for critical level filtering. + integer :: Umini(ncol), Umaxi(ncol) + ! Source level tau for a column. + real(r8) :: tau0(-band%ngwv:band%ngwv) + ! Speed of convective cells relative to storm. + real(r8) :: CS(ncol),CS1(ncol) + ! Wind speeds in wave direction + real(r8) :: udiff(ncol),vdiff(ncol) + ! "on-crest" source level wind + real(r8) :: ubmsrc(ncol),ubisrc(ncol) + + ! Index to shift spectra relative to ground. + integer :: shift + ! Other wind quantities + real(r8) :: ut(ncol),uc(ncol),umm(ncol) + ! Tau from moving mountain lookup table + real(r8) :: taumm(ncol) + ! Heating rate conversion factor. -> tuning factors + real(r8), parameter :: CF = 20._r8 !(1/ (5%)) -> 5% of grid cell is covered with convection + ! Averaging length. + real(r8), parameter :: AL = 1.0e5_r8 + ! Index for moving mountain lookuptable + integer :: hdmm_idx(ncol), uhmm_idx(ncol) + ! Index for ground based phase speed bin + real(r8) :: c0(ncol,-band%ngwv:band%ngwv) + integer :: c_idx(ncol,-band%ngwv:band%ngwv) + ! Flux source from ShCu/PBL + real(r8) :: xpwp_src(ncol) + ! Manual steering level set + integer :: Steer_k + + !---------------------------------------------------------------------- + ! Initialize tau array + !---------------------------------------------------------------------- + tau = 0.0_r8 + hdepth = 0.0_r8 + q0 = 0.0_r8 + tau0 = 0.0_r8 + + !---------------------------------------------------------------------- + ! Calculate flux source from ShCu/PBL + !---------------------------------------------------------------------- + xpwp_src = shcu_flux_src( xpwp_shcu, ncol, pver+1, alpha_gw_movmtn ) + + !------------------------------------------------------------------------ + ! Determine wind and unit vectors approximately at the source (steering level), then + ! project winds. + !------------------------------------------------------------------------ + + ! Winds at 'steering level' + Steer_k = pver-1 + usteer = u(:,Steer_k) !k defined in line21 (at specified altitude) + vsteer = v(:,Steer_k) + steer_level = real(Steer_k,r8) + + ! all GW calculations on a plane, which in our case is the wind at source level -> ubi is wind in this plane + ! Get the unit vector components and magnitude at the source level. + call get_unit_vector(usteer, vsteer, xv_steer, yv_steer, umag_steer) + + !------------------------------------------------------------------------- + ! If we want to account for some retorgrade cell motion, + ! it should be done by vector subtraction from (usteer,vsteer). + ! We assume the retrograde motion is in the same direction as + ! (usteer,vsteer) or the unit vector (xv_steer,yv_steer). Then, the + ! vector retrograde motion is just: + ! = -Cell_Retrograde_Speed * (xv_steer,yv_steer) + ! and we would modify usteer and vsteer + ! usteer = usteer - Cell_Retrograde_Speed * xv_steer + ! vsteer = vsteer - Cell_Retrograde_Speed * yv_steer + !----------------------------------------------------------------------- + ! Cell_Retro_Speed is always =0 for now + !----------------------------------------------------------------------- + do i=1,ncol + Cell_Retro_Speed(i) = min( sqrt(usteer(i)**2 + vsteer(i)**2), 0._r8) + end do + do i=1,ncol + usteer(i) = usteer(i) - xv_steer(i)*Cell_Retro_Speed(i) + vsteer(i) = vsteer(i) - yv_steer(i)*Cell_Retro_Speed(i) + end do + !------------------------------------------------------------------------- + ! At this point (usteer,vsteer) is the cell-speed, or equivalently, the 2D + ! ground based wave phase speed for moving mountain GW + !------------------------------------------------------------------------- + + + ! Calculate heating depth. + ! + ! Heating depth is defined as the first height range from the bottom in + ! which heating rate is continuously positive. + !----------------------------------------------------------------------- + + ! First find the indices for the top and bottom of the heating range. + !nedt is heating profile from Zhang McFarlane (it's pressure coordinates, therefore k=0 is the top) + + boti = 0 !bottom + topi = 0 !top + + if (use_gw_movmtn_pbl) then + boti=pver + topi=Steer_k-10 ! desc%k-5 + else + do k = pver, 1, -1 !start at surface + do i = 1, ncol + if (boti(i) == 0) then + ! Detect if we are outside the maximum range (where z = 20 km). + if (zm(i,k) >= 20000._r8) then + boti(i) = k + topi(i) = k + else + ! First spot where heating rate is positive. + if (netdt(i,k) > 0.0_r8) boti(i) = k + end if + else if (topi(i) == 0) then + ! Detect if we are outside the maximum range (z = 20 km). + if (zm(i,k) >= 20000._r8) then + topi(i) = k + else + ! First spot where heating rate is no longer positive. + if (.not. (netdt(i,k) > 0.0_r8)) topi(i) = k + end if + end if + end do + ! When all done, exit. + if (all(topi /= 0)) exit + end do + end if + ! Heating depth in m. (top-bottom altitudes) + hdepth = [ ( (zm(i,topi(i))-zm(i,boti(i))), i = 1, ncol ) ] + hd_idx = index_of_nearest(hdepth, desc%hd) + + ! hd_idx=0 signals that a heating depth is too shallow, i.e. that it is + ! either not big enough for the lowest table entry, or it is below the + ! minimum allowed for this convection type. + ! Values above the max in the table still get the highest value, though. + + where (hdepth < max(desc%min_hdepth, desc%hd(1))) hd_idx = 0 + + ! Maximum heating rate. + do k = minval(topi), maxval(boti) + where (k >= topi .and. k <= boti) + q0 = max(q0, netdt(:,k)) + end where + end do + + ! Multiply by conversion factor + ! (now 20* larger than what Zhang McFarlane said as they try to describe heating over 100km grid cell) + q0 = q0 * CF + qj = gravit/rair*q0 ! unit conversion to m/s3 + + !------------------------------------------------- + ! CS1 and CS should be equal in current implemen- + ! tation. + !------------------------------------------------- + CS1 = sqrt( usteer**2._r8 + vsteer**2._r8 ) + CS = CS1*xv_steer + CS1*yv_steer + + ! ----------------------------------------------------------- + ! Calculate winds in reference frame of wave (uwavef,vwavef). + ! This is like "(U-c)" in GW literature, where U and c are in + ! ground-based speeds in a plane perpendicular to wave fronts. + !------------------------------------------------------------ + do i=1,ncol + udiff(i) = u(i,topi(i)) - usteer(i) + vdiff(i) = v(i,topi(i)) - vsteer(i) + do k=1,pver + uwavef(i, k ) = u(i, k ) - usteer(i) + vwavef(i, k ) = v(i, k ) - vsteer(i) + end do + end do + !---------------------------------------------------------- + ! Wave relative wind at source level. This determines + ! orientation of wave in the XY plane, and therefore the + ! direction in which force from dissipating GW will be + ! applied. + !---------------------------------------------------------- + do i=1,ncol + udiff(i) = uwavef( i, topi(i) ) + vdiff(i) = vwavef( i, topi(i) ) + end do + !----------------------------------------------------------- + ! Unit vector components (xv,yv) in direction of wavevector + ! i.e., in which force will be applied + !----------------------------------------------------------- + call get_unit_vector(udiff , vdiff , xv, yv, ubisrc ) + + call outfld('UCELL_MOVMTN', usteer, ncol, lchnk) + call outfld('VCELL_MOVMTN', vsteer, ncol, lchnk) + call outfld('CS_MOVMTN', CS, ncol, lchnk) + call outfld('STEER_LEVEL_MOVMTN',steer_level, ncol, lchnk ) + call outfld('XPWP_SRC_MOVMTN', xpwp_src , ncol, lchnk ) + + !---------------------------------------------------------- + ! Project the local wave relative wind at midpoints onto the + ! direction of the wavevector. + !---------------------------------------------------------- + do k = 1, pver + ubm(:,k) = dot_2d(uwavef(:,k), vwavef(:,k), xv, yv) + end do + ! Source level on-crest wind + do i=1,ncol + ubmsrc(i) = ubm(i,topi(i)) + end do + + !--------------------------------------------------------------- + ! adjust everything so that source level wave relative on-crest + ! wind is always positive. Also adjust unit vector comps xv,yv + !-------------------------------------------------------------- + do k=1,pver + do i=1,ncol + ubm(i,k) = sign( 1._r8 , ubmsrc(i) )* ubm(i,k) + end do + end do + ! + do i=1,ncol + xv(i) = sign( 1._r8 , ubmsrc(i) ) * xv(i) + yv(i) = sign( 1._r8 , ubmsrc(i) ) * yv(i) + end do + + + + ! Compute the interface wind projection by averaging the midpoint winds. (both same wind profile, + ! just at different points of the grid) + + ! Use the top level wind at the top interface. + ubi(:,1) = ubm(:,1) + + ubi(:,2:pver) = midpoint_interp(ubm) + + !----------------------------------------------------------------------- + ! determine wind for lookup table + ! need wind speed at the top of the convecitve cell and at the steering level + uh = 0._r8 + do i=1,ncol + ut(i) = ubm(i,topi(i)) + uh(i) = ut(i) - CS(i) ! wind at top in the frame moving with the cell + end do + + ! Set phase speeds; just use reference speeds. + c(:,0) = 0._r8 + + !----------------------------------------------------------------------- + ! Gravity wave sources + !----------------------------------------------------------------------- + ! Start loop over all columns. + !----------------------------------------------------------------------- + do i=1,ncol + + !--------------------------------------------------------------------- + ! Look up spectrum only if the heating depth is large enough, else leave + ! tau = 0. + !--------------------------------------------------------------------- + if (.not. use_gw_movmtn_pbl) then + if (hd_idx(i) > 0) then + !------------------------------------------------------------------ + ! Look up the spectrum using depth and uh. + !------------------------------------------------------------------ + !hdmm_idx = index_of_nearest(hdepth, desc%hd) + uhmm_idx = index_of_nearest(uh, desc%uh) + taumm(i) = abs(desc%mfcc(uhmm_idx(i),hd_idx(i),0)) + taumm(i) = taumm(i)*qj(i)*qj(i)/AL/1000._r8 + ! assign sign to MF based on the ground based phase speed, ground based phase speed = CS + taumm(i) = -1._r8*sign(taumm(i),CS(i)) + !find the right phase speed bin + c0(i,:) = CS(i) + c_idx(i,:) = index_of_nearest(c0(i,:),c(i,:)) + + !input tau to top +1 level, interface level just below top of heating, remember it's in pressure + ! everything is upside down (source level of GWs, level where GWs are launched) + tau(i,c_idx(i,:),topi(i):topi(i)+1) = taumm(i) + + end if ! heating depth above min and not at the pole + else + tau(i,0,topi(i):pver+1 ) = xpwp_src(i) ! 0.1_r8/10000._r8 + endif + + enddo + !----------------------------------------------------------------------- + ! End loop over all columns. + !----------------------------------------------------------------------- + + ! Output the source level. + src_level = topi + tend_level = topi + + +end subroutine gw_movmtn_src + +! Short routine to get the indices of a set of values rounded to their +! nearest points on a grid. +pure function index_of_nearest(x, grid) result(idx) + real(r8), intent(in) :: x(:) + real(r8), intent(in) :: grid(:) + + integer :: idx(size(x)) + + real(r8) :: interfaces(size(grid)-1) + integer :: i, n + + n = size(grid) + interfaces = (grid(:n-1) + grid(2:))/2._r8 + + idx = 1 + do i = 1, n-1 + where (x > interfaces(i)) idx = i + 1 + end do + +end function index_of_nearest + +!!!!!!!!!!!!!!!!!!!!!!!!!!! +pure function shcu_flux_src (xpwp_shcu , ncol, pverx, alpha_gw_movmtn ) result(xpwp_src) + integer, intent(in) :: ncol,pverx + real(r8), intent(in) :: xpwp_shcu (ncol,pverx) + real(r8), intent(in) :: alpha_gw_movmtn + + real(r8) :: xpwp_src(ncol) + + integer :: k, nlayers + + !----------------------------------- + ! Simple average over layers. + ! Probably can do better + !----------------------------------- + nlayers=5 + xpwp_src(:) =0._r8 + do k = 0, nlayers-1 + xpwp_src(:) = xpwp_src(:) + xpwp_shcu(:,pverx-k) + end do + xpwp_src(:) = alpha_gw_movmtn * xpwp_src(:)/(1.0_r8*nlayers) + +end function shcu_flux_src + +end module gw_movmtn diff --git a/src/physics/cam/hb_diff.F90 b/src/physics/cam/hb_diff.F90 index ba97978e72..a3bb11a17d 100644 --- a/src/physics/cam/hb_diff.F90 +++ b/src/physics/cam/hb_diff.F90 @@ -262,7 +262,7 @@ subroutine compute_hb_free_atm_diff(ncol, & ! !----------------------------------------------------------------------- - use pbl_utils, only: virtem, calc_ustar, calc_obklen, austausch_atm + use pbl_utils, only: virtem, calc_ustar, calc_obklen, austausch_atm_free !------------------------------Arguments-------------------------------- ! @@ -321,7 +321,7 @@ subroutine compute_hb_free_atm_diff(ncol, & ! ! Get free atmosphere exchange coefficients ! - call austausch_atm(pcols, ncol, pver, ntop_turb, nbot_turb, & + call austausch_atm_free(pcols, ncol, pver, ntop_turb, nbot_turb, & ml2, ri, s2, kvf) kvq(:ncol,:) = kvf(:ncol,:) diff --git a/src/physics/cam/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 1de052c318..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) 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/physpkg.F90 b/src/physics/cam/physpkg.F90 index b2a6832eab..550efdbe6d 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 @@ -777,7 +778,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 @@ -909,7 +910,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) endif endif - call cloud_diagnostics_init() + call cloud_diagnostics_init(pbuf2d) call radheat_init(pref_mid) @@ -952,7 +953,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 +1088,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 +1156,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') @@ -2067,7 +2066,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 @@ -2135,8 +2134,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 @@ -2797,10 +2796,22 @@ subroutine tphysbc (ztodt, state, & ! wet scavenging but not 'convect_deep_tend2'. ! ------------------------------------------------------------------------------- - call t_startf('bc_aerosols') - if (clim_modal_aero .and. .not. prog_modal_aero) then - call modal_aero_calcsize_diag(state, pbuf) - call modal_aero_wateruptake_dr(state, pbuf) + call t_startf('aerosol_wet_processes') + if (clim_modal_aero) then + if (prog_modal_aero) then + call physics_ptend_init(ptend, state%psetcols, 'aero_water_uptake', lq=wetdep_lq) + ! Do calculations of mode radius and water uptake if: + ! 1) modal aerosols are affecting the climate, or + ! 2) prognostic modal aerosols are enabled + call modal_aero_calcsize_sub(state, ptend, ztodt, pbuf) + ! for prognostic modal aerosols the transfer of mass between aitken and accumulation + ! modes is done in conjunction with the dry radius calculation + call modal_aero_wateruptake_dr(state, pbuf) + call physics_update(state, ptend, ztodt, tend) + else + call modal_aero_calcsize_diag(state, pbuf) + call modal_aero_wateruptake_dr(state, pbuf) + endif endif if (trim(cam_take_snapshot_before) == "aero_model_wetdep") then @@ -2840,7 +2851,7 @@ subroutine tphysbc (ztodt, state, & ! check tracer integrals call check_tracers_chng(state, tracerint, "cmfmca", nstep, ztodt, zero_tracers) - call t_stopf('bc_aerosols') + call t_stopf('aerosol_wet_processes') endif diff --git a/src/physics/cam/subcol_SILHS.F90 b/src/physics/cam/subcol_SILHS.F90 index e941889e50..c373ed6b3e 100644 --- a/src/physics/cam/subcol_SILHS.F90 +++ b/src/physics/cam/subcol_SILHS.F90 @@ -19,16 +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 @@ -59,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 !----- @@ -334,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 @@ -357,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 @@ -367,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. @@ -446,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, & - newunit(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 @@ -600,31 +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, & - - 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, & @@ -844,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 @@ -885,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 !---------------- @@ -902,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 @@ -1129,27 +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), & ! 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_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 + 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 @@ -1220,15 +1240,11 @@ 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_metadata, & ! In stats_lh_zt, stats_lh_sfc, & ! InOut @@ -1236,15 +1252,15 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) 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 diff --git a/src/physics/cam/zm_conv_intr.F90 b/src/physics/cam/zm_conv_intr.F90 index 92a0c774a7..13439be5f1 100644 --- a/src/physics/cam/zm_conv_intr.F90 +++ b/src/physics/cam/zm_conv_intr.F90 @@ -241,8 +241,8 @@ subroutine zm_conv_init(pref_edge) ! 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), 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 @@ -598,7 +598,7 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & 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), & + 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), & @@ -833,7 +833,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 ) @@ -933,7 +933,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/cam7/physpkg.F90 b/src/physics/cam7/physpkg.F90 index 2d652fa2d7..af9fc8d3ef 100644 --- a/src/physics/cam7/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 @@ -761,7 +762,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 +888,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) endif endif - call cloud_diagnostics_init() + call cloud_diagnostics_init(pbuf2d) call radheat_init(pref_mid) @@ -920,7 +921,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') @@ -1054,9 +1055,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 +1123,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 +1398,7 @@ subroutine tphysac (ztodt, cam_in, & use radiation, only: radiation_tend use tropopause, only: tropopause_output use cam_diagnostics, only: diag_phys_writeout, diag_conv, diag_clip_tend_writeout - use aero_model, only: aero_model_wetdep + use aero_model, only: aero_model_wetdep, wetdep_lq use physics_buffer, only: col_type_subcol use check_energy, only: check_energy_timestep_init use carma_intr, only: carma_wetdep_tend, carma_timestep_tend, carma_emission_tend @@ -1921,10 +1920,22 @@ subroutine tphysac (ztodt, cam_in, & ! wet scavenging but not 'convect_deep_tend2'. ! ------------------------------------------------------------------------------- - call t_startf('bc_aerosols') - if (clim_modal_aero .and. .not. prog_modal_aero) then - call modal_aero_calcsize_diag(state, pbuf) - call modal_aero_wateruptake_dr(state, pbuf) + call t_startf('aerosol_wet_processes') + if (clim_modal_aero) then + if (prog_modal_aero) then + call physics_ptend_init(ptend, state%psetcols, 'aero_water_uptake', lq=wetdep_lq) + ! Do calculations of mode radius and water uptake if: + ! 1) modal aerosols are affecting the climate, or + ! 2) prognostic modal aerosols are enabled + call modal_aero_calcsize_sub(state, ptend, ztodt, pbuf) + ! for prognostic modal aerosols the transfer of mass between aitken and accumulation + ! modes is done in conjunction with the dry radius calculation + call modal_aero_wateruptake_dr(state, pbuf) + call physics_update(state, ptend, ztodt, tend) + else + call modal_aero_calcsize_diag(state, pbuf) + call modal_aero_wateruptake_dr(state, pbuf) + endif endif if (trim(cam_take_snapshot_before) == "aero_model_wetdep") then @@ -1966,7 +1977,7 @@ subroutine tphysac (ztodt, cam_in, & ! check tracer integrals call check_tracers_chng(state, tracerint, "cmfmca", nstep, ztodt, zero_tracers) - call t_stopf('bc_aerosols') + call t_stopf('aerosol_wet_processes') endif diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 18488bedb7..ca81be4326 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -453,6 +453,7 @@ subroutine radiation_init(pbuf2d) ! pressure interfaces below 1 Pa. When the entire model atmosphere is ! below 1 Pa then an extra layer is added to the top of the model for ! the purpose of the radiation calculation. + nlay = count( pref_edge(:) > 1._r8 ) ! pascals (0.01 mbar) if (nlay == pverp) then @@ -461,6 +462,14 @@ subroutine radiation_init(pbuf2d) ktopcam = 1 ktoprad = 2 nlaycam = pver + else if (nlay == (pverp-1)) then + ! Special case nlay == (pverp-1) -- topmost interface outside bounds (CAM MT config), treat as if it is ok. + ktopcam = 1 + ktoprad = 2 + nlaycam = pver + nlay = nlay+1 ! reassign the value so later code understands to treat this case like nlay==pverp + write(iulog,*) 'RADIATION_INIT: Special case of 1 model interface at p < 1Pa. Top layer will be INCLUDED in radiation calculation.' + write(iulog,*) 'RADIATION_INIT: nlay = ',nlay, ' same as pverp: ',nlay==pverp else ! nlay < pverp. nlay layers are used in radiation calcs, and they are ! all CAM layers. @@ -468,7 +477,7 @@ subroutine radiation_init(pbuf2d) ktoprad = 1 nlaycam = nlay end if - + ! Create lowercase version of the gaslist for RRTMGP. The ty_gas_concs objects ! work with CAM's uppercase names, but other objects that get input from the gas ! concs objects don't work. 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/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/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/test/system/archive_baseline.sh b/test/system/archive_baseline.sh index 8460923a1f..f64561dc4d 100755 --- a/test/system/archive_baseline.sh +++ b/test/system/archive_baseline.sh @@ -12,7 +12,7 @@ cat << EOF1 NAME archive_baseline.sh - archive pretag baselines to set locations on - hobart, izumi and derecho. + izumi and derecho. SYNOPSIS @@ -24,41 +24,28 @@ SYNOPSIS ENVIROMENT VARIABLES CESM_TESTDIR - Directory that contains the CESM finished results you wish to archive. - CAM_FC - Compiler used, only used on hobart and izumi (PGI,NAG), where the compiler + CAM_FC - Compiler used, used on derecho (INTEL, NVHPC) and izumi (GNU,NAG), where the compiler name is appended to the archive directory. BASELINE ARCHIVED LOCATION - hobart, izumi: /fs/cgd/csm/models/atm/cam/pretag_bl/TAGNAME_pgi - /fs/cgd/csm/models/atm/cam/pretag_bl/TAGNAME_nag - derecho: /glade/campaign/cesm/community/amwg/cam_baselines/TAGNAME + izumi: /fs/cgd/csm/models/atm/cam/pretag_bl/TAGNAME_gnu + /fs/cgd/csm/models/atm/cam/pretag_bl/TAGNAME_nag + derecho: /glade/campaign/cesm/community/amwg/cam_baselines/TAGNAME_intel + /glade/campaign/cesm/community/amwg/cam_baselines/TAGNAME_nvhpc HOW TO USE ARCHIVE BASELINES - Set BL_TESTDIR to the archived baseline you wish to load. + on izumi: + env CESM_TESTDIR=/scratch/cluster/YourName/aux_cam_gnu_yyyymmddsssss CAM_FC=GNU ./archive_baseline.sh cam6_4_XXX + env CESM_TESTDIR=/scratch/cluster/YourName/aux_cam_nag_yyyymmddsssss CAM_FC=NAG ./archive_baseline.sh cam6_3_XXX - -WORK FLOW - - This is an example for hobart or izumi. - - Modify your sandbox with the changes you want. - setenv CAM_FC PGI - setenv CAM_TESTDIR /scratch/cluster/fischer/cam5_2_06 - Run the cam test suite. - Make your trunk tag - archive_baseline.sh cam5_2_06 - - Create a new sandbox. - setenv CAM_FC PGI - setenv CAM_TESTDIR /scratch/cluster/fischer/cam5_2_07 - setenv BL_TESTDIR /fs/cgd/csm/models/atm/cam/pretag_bl/cam5_2_06_pgi - Run the cam test suite. - Make your trunk tag - archive_baseline.sh cam5_2_07 + on derecho: + env CESM_TESTDIR=/glade/derecho/scratch/YourName/aux_cam_intel_yyyymmddsssss CAM_FC=INTEL ./archive_baseline.sh cam6_4_XXX + env CESM_TESTDIR=/glade/derecho/scratch/YourName/aux_cam_nvhpc_yyyymmddsssss CAM_FC=NVHPC ./archive_baseline.sh cam6_4_XXX WARNING @@ -73,20 +60,10 @@ fi hostname=`hostname` case $hostname in - ho*) - echo "server: hobart" - if [ -z "$CAM_FC" ]; then - CAM_FC="PGI" - fi - test_file_list="tests_pretag_hobart_${CAM_FC,,}" - cam_tag=$1_${CAM_FC,,} - baselinedir="/fs/cgd/csm/models/atm/cam/pretag_bl/$cam_tag" - ;; - iz*) echo "server: izumi" if [ -z "$CAM_FC" ]; then - CAM_FC="PGI" + echo "Must specify CAM_FC" fi test_file_list="tests_pretag_izumi_${CAM_FC,,}" cam_tag=$1_${CAM_FC,,} @@ -96,10 +73,10 @@ case $hostname in de*) echo "server: derecho" if [ -z "$CAM_FC" ]; then - CAM_FC="INTEL" + echo "Must specify CAM_FC" fi - test_file_list="tests_pretag_derecho" - cam_tag=$1 + test_file_list="tests_pretag_derecho_${CAM_FC,,}" + cam_tag=$1_${CAM_FC,,} baselinedir="/glade/campaign/cesm/community/amwg/cam_baselines/$cam_tag" ;; @@ -130,7 +107,7 @@ fi case $hostname in - ch* | hobart | izumi) + de* | izumi) if [ -z "$CESM_TESTDIR" ]; then echo '***********************************************************************************' echo 'INFO: The aux_cam and test_cam tests were NOT archived' diff --git a/test/system/test_driver.sh b/test/system/test_driver.sh index 80a632b14f..a53d0762d8 100755 --- a/test/system/test_driver.sh +++ b/test/system/test_driver.sh @@ -466,6 +466,9 @@ if [ "${hostname:0:6}" == "casper" ] || [ "${hostname:0:5}" == "crhtc" ]; then fi if [ -n "${CAM_FC}" ]; then comp="_${CAM_FC,,}" +else + echo "ERROR: Must specify CAM_FC" + exit 1 fi if [ "${cesm_test_suite}" != "none" -a -n "${cesm_test_mach}" ]; then @@ -547,8 +550,6 @@ if [ "${cesm_test_suite}" != "none" -a -n "${cesm_test_mach}" ]; then if [ -n "${CAM_FC}" ]; then testargs="${testargs} --xml-compiler ${CAM_FC,,}" - else - testargs="${testargs} --xml-compiler intel" fi case $hostname in # derecho @@ -586,8 +587,6 @@ if [ "${cesm_test_suite}" != "none" -a -n "${cesm_test_mach}" ]; then cmd="query_testlists --xml-category $cesm_test --xml-machine ${cesm_test_mach}" if [ -n "${CAM_FC}" ]; then cmd="${cmd} --xml-compiler ${CAM_FC,,}" - else - cmd="${cmd} --xml-compiler intel" fi cmd="${CIME_ROOT}/scripts/"$cmd cime_testlist=`$cmd`